Instalamos y cargamos las librerías necesarias.

if (!require('ggplot2')) install.packages('ggplot2'); library('ggplot2')
if (!require('dplyr')) install.packages('dplyr'); library('dplyr')
if (!require('GGally')) install.packages('GGally'); library(GGally)
if (!require('DataExplorer')) install.packages("DataExplorer"); library(DataExplorer)
if (!require('dlookr')) install.packages("dlookr"); library(dlookr)
if (!require('tidymodels')) install.packages("tidymodels"); library(tidymodels)
if (!require('flextable')) install.packages("flextable"); library(flextable)
if (!require('corrplot')) install.packages("corrplot"); library(corrplot)
if (!require('textshape')) install.packages("textshape"); library(textshape)
if (!require('stats')) install.packages("stats"); library(stats)
if (!require('FactoMineR')) install.packages("FactoMineR"); library(FactoMineR)
if (!require('factoextra')) install.packages("factoextra"); library(factoextra)
if (!require('cluster')) install.packages('cluster'); library(cluster)
if (!require('dbscan')) install.packages('dbscan'); library('dbscan')
if (!require('amap')) install.packages('amap'); library('amap')
if (!require('DescTools')) install.packages('DescTools', repos='http://cran.us.r-project.org'); library(DescTools)
if (!require('caTools')) install.packages('caTools'); library('caTools')
if (!require('gmodels')) install.packages('gmodels', repos='http://cran.us.r-project.org'); library(gmodels)
if (!require('class')) install.packages('class'); library('class')

1 PRIMERA PARTE


1.1 Elección del conjunto de datos

En Europa, el paro cardiaco es una de las primeras causas de mortalidad y en España fallecen en torno a 100 personas al día por este suceso (https://fundaciondelcorazon.com/prensa/notas-de-prensa/2900-solo-el-30-de-espanoles-sabe-realizar-la-reanimacion-cardio-pulmonar-rcp-.html), esto representa aproximadamente el 31% de las muertes a nivel mundial.

Por esta razón, se han seleccionado dos conjuntos de datos, el primer conjunto (https://www.kaggle.com/fedesoriano/heart-failure-prediction?select=heart.csv) contiene 12 características y el segundo (https://www.kaggle.com/ronitf/heart-disease-uci) contiene 13 características. Aunque el número de características que contienen son distintas, muchas son comunes entre los dos y esto permitirá crear un conjunto de datos más completo.

Los dos conjuntos de datos han sido elegidos por las características que estos contienen, ya que son los parámetros típicos usados en los estudios de problemas del corazón, y es por eso por lo que tras el análisis de estos se puede sacar unas conclusiones bastantes interesantes.

Finalmente, se puede decir que el objetivo buscado es predecir la posibilidad de que una persona tenga un alto riesgo de ser diagnosticado como un paciente cardíaco a través de las diversas características. Para llegar a al objetivo se tiene pensado realizar diversos métodos de análisis para así relacionar las diversas características para obtener unos parámetros finales y así concluir la posibilidad de que una persona tenga o no una enfermedad cardiaca.

1.2 Exploración del conjunto de datos

A continuación, se van a exponer las diferentes características de los conjuntos de datos.

1.2.1 Características del Primer conjunto de datos

Del primer conjunto, como se ha mencionado anteriormente tenemos 12 características distintas:

  • Age: edad del paciente [años]
  • Sex: sexo del paciente [M: Masculino, F: Femenino]
  • ChestPainType: tipo de dolor de pecho [TA: angina típica, ATA: angina atípica, NAP: dolor no anginal, ASY: asintomático]
  • RestingBP: presión arterial en reposo [mm Hg]
  • Cholesterol: colesterol sérico [mm / dl]
  • FastingBS: azúcar en sangre en ayunas [1: si BS en ayunas> 120 mg / dl, 0: en caso contrario]
  • RestingECG: resultados del electrocardiograma en reposo [Normal: Normal, ST: con anomalía de la onda ST-T (inversiones de la onda T y / o elevación o depresión del ST> 0,05 mV), LVH: que muestra una hipertrofia ventricular izquierda probable o definitiva según los criterios de Estes]
  • MaxHR: frecuencia cardíaca máxima alcanzada [Valor numérico entre 60 y 202]
  • ExerciseAngina: angina inducida por el ejercicio [Y: Sí, N: No]
  • Oldpeak: oldpeak = ST [Valor numérico medido en depresión]
  • ST_Slope: la pendiente del segmento ST del ejercicio pico [Up: uploping, Flat: flat, Down: downsloping]
  • HeartDisease: clase de salida [1: enfermedad cardíaca, 0: Normal]

1.2.2 Características del Segundo conjunto de datos

El segundo conjunto de datos tiene las siguientes características:

  • Age: la edad de la persona en años
  • sex: el sexo de la persona [1 = hombre, 0 = mujer]
  • cp: el dolor torácico experimentado [valor 0: angina típica, valor 1: angina atípica, valor 2: dolor no anginoso, valor 3: asintomático]
  • trestbps: la presión arterial en reposo de la persona [mm Hg al ingreso en el hospital]
  • chol: la medición del colesterol de la persona en mg / dl
  • fbs: nivel de azúcar en sangre en ayunas de la persona [> 120 mg / dl, 1 = verdadero; 0 = falso]
  • restecg: medición electrocardiográfica en reposo [0 = normal, 1 = con anomalía de la onda ST-T, 2 = mostrando hipertrofia ventricular izquierda probable o definitiva según los criterios de Estes]
  • thalach: frecuencia cardíaca máxima alcanzada por la persona
  • exang: angina inducida por ejercicio [1 = sí; 0 = no]
  • oldpeak: depresión del ST inducida por el ejercicio en relación con el reposo.
  • Slope: la pendiente del segmento ST de ejercicio pico [Valor 0: pendiente ascendente, Valor 1: plano, Valor 2: pendiente descendente]
  • ca: Número de vasos principales (0-3) coloreados por la floración
  • Thal: Trastorno de la sangre llamado talasemia [3 = normal; 6 = defecto fijo; 7 = defecto reversible]
  • target: clase de salida [1: enfermedad cardíaca, 0: Normal]

1.2.3 Características comunes y no comunes de los dos juego de datos

Como se puede observar, las características de los dos conjuntos de datos que coinciden son:

Comparación de características
Primer conjunto de datos Segundo conjunto de datos Significado
Age Age Edad de la persona
Sex Sex Sexo de la persona
ChestPainType cp Tipo dolor torácico
RestingBP trestbps Presión arterial en reposo
Cholesterol chol colesterol de la persona
FastingBS fbs Nivel de azúcar en sangre
RestingECG restecg ECG en reposo
MaxHR thalach Frecuencia cardíaca máxima
ExerciseAngina exang Angina inducida por ejercicio
Oldpeak oldpeak depresión del ST
ST_Slope Slope pendiente del segmento ST
HeartDisease target ¿Enfermedad Cardiaca?

Las únicas características que no se encuentran en el primer conjunto de datos son:

  • ca: Número de vasos principales coloreados por la floración
  • Thal: Trastorno de la sangre llamado talasemia

1.2.4 Carga de los conjuntos de datos

Una vez identificadas las características, cargamos los archivos para un análisis exploratorio del conjunto de datos.

#Cargamos el primer fichero
datos1 <- read.csv('heart.csv')

#Cargamos el segundo fichero
datos2 <- read.csv('heart_1.csv')

#Filas del primer fichero
filas_1 = dim(datos1)[1]

#Filas del segundo fichero
filas_2 = dim(datos2)[1]

Ahora vamos a ver las estructura de los juegos de datos

#Verificamos la estructura del primer juego
str(datos1)
## 'data.frame':    918 obs. of  12 variables:
##  $ Age           : int  40 49 37 48 54 39 45 54 37 48 ...
##  $ Sex           : chr  "M" "F" "M" "F" ...
##  $ ChestPainType : chr  "ATA" "NAP" "ATA" "ASY" ...
##  $ RestingBP     : int  140 160 130 138 150 120 130 110 140 120 ...
##  $ Cholesterol   : int  289 180 283 214 195 339 237 208 207 284 ...
##  $ FastingBS     : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ RestingECG    : chr  "Normal" "Normal" "ST" "Normal" ...
##  $ MaxHR         : int  172 156 98 108 122 170 170 142 130 120 ...
##  $ ExerciseAngina: chr  "N" "N" "N" "Y" ...
##  $ Oldpeak       : num  0 1 0 1.5 0 0 0 0 1.5 0 ...
##  $ ST_Slope      : chr  "Up" "Flat" "Up" "Flat" ...
##  $ HeartDisease  : int  0 1 0 1 0 0 0 0 1 0 ...
#Verificamos la estructura del segundo juego
str(datos2)
## 'data.frame':    303 obs. of  14 variables:
##  $ ï..age  : int  63 37 41 56 57 57 56 44 52 57 ...
##  $ sex     : int  1 1 0 1 0 1 0 1 1 1 ...
##  $ cp      : int  3 2 1 1 0 0 1 1 2 2 ...
##  $ trestbps: int  145 130 130 120 120 140 140 120 172 150 ...
##  $ chol    : int  233 250 204 236 354 192 294 263 199 168 ...
##  $ fbs     : int  1 0 0 0 0 0 0 0 1 0 ...
##  $ restecg : int  0 1 0 1 1 1 0 1 1 1 ...
##  $ thalach : int  150 187 172 178 163 148 153 173 162 174 ...
##  $ exang   : int  0 0 0 0 1 0 0 0 0 0 ...
##  $ oldpeak : num  2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 0.5 1.6 ...
##  $ slope   : int  0 0 2 2 2 1 1 2 2 2 ...
##  $ ca      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ thal    : int  1 2 2 2 2 1 2 3 3 2 ...
##  $ target  : int  1 1 1 1 1 1 1 1 1 1 ...

Vamos ahora a sacar estadísticas básicas de los juegos de datos

#Estadísticas básica del primer juego
summary(datos1)
##       Age            Sex            ChestPainType        RestingBP      Cholesterol      FastingBS       RestingECG            MaxHR       ExerciseAngina    
##  Min.   :28.00   Length:918         Length:918         Min.   :  0.0   Min.   :  0.0   Min.   :0.0000   Length:918         Min.   : 60.0   Length:918        
##  1st Qu.:47.00   Class :character   Class :character   1st Qu.:120.0   1st Qu.:173.2   1st Qu.:0.0000   Class :character   1st Qu.:120.0   Class :character  
##  Median :54.00   Mode  :character   Mode  :character   Median :130.0   Median :223.0   Median :0.0000   Mode  :character   Median :138.0   Mode  :character  
##  Mean   :53.51                                         Mean   :132.4   Mean   :198.8   Mean   :0.2331                      Mean   :136.8                     
##  3rd Qu.:60.00                                         3rd Qu.:140.0   3rd Qu.:267.0   3rd Qu.:0.0000                      3rd Qu.:156.0                     
##  Max.   :77.00                                         Max.   :200.0   Max.   :603.0   Max.   :1.0000                      Max.   :202.0                     
##     Oldpeak          ST_Slope          HeartDisease   
##  Min.   :-2.6000   Length:918         Min.   :0.0000  
##  1st Qu.: 0.0000   Class :character   1st Qu.:0.0000  
##  Median : 0.6000   Mode  :character   Median :1.0000  
##  Mean   : 0.8874                      Mean   :0.5534  
##  3rd Qu.: 1.5000                      3rd Qu.:1.0000  
##  Max.   : 6.2000                      Max.   :1.0000
#Estadísticas básica del segundo juego
summary(datos2)
##      ï..age           sex               cp           trestbps          chol            fbs            restecg          thalach          exang           oldpeak    
##  Min.   :29.00   Min.   :0.0000   Min.   :0.000   Min.   : 94.0   Min.   :126.0   Min.   :0.0000   Min.   :0.0000   Min.   : 71.0   Min.   :0.0000   Min.   :0.00  
##  1st Qu.:47.50   1st Qu.:0.0000   1st Qu.:0.000   1st Qu.:120.0   1st Qu.:211.0   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:133.5   1st Qu.:0.0000   1st Qu.:0.00  
##  Median :55.00   Median :1.0000   Median :1.000   Median :130.0   Median :240.0   Median :0.0000   Median :1.0000   Median :153.0   Median :0.0000   Median :0.80  
##  Mean   :54.37   Mean   :0.6832   Mean   :0.967   Mean   :131.6   Mean   :246.3   Mean   :0.1485   Mean   :0.5281   Mean   :149.6   Mean   :0.3267   Mean   :1.04  
##  3rd Qu.:61.00   3rd Qu.:1.0000   3rd Qu.:2.000   3rd Qu.:140.0   3rd Qu.:274.5   3rd Qu.:0.0000   3rd Qu.:1.0000   3rd Qu.:166.0   3rd Qu.:1.0000   3rd Qu.:1.60  
##  Max.   :77.00   Max.   :1.0000   Max.   :3.000   Max.   :200.0   Max.   :564.0   Max.   :1.0000   Max.   :2.0000   Max.   :202.0   Max.   :1.0000   Max.   :6.20  
##      slope             ca              thal           target      
##  Min.   :0.000   Min.   :0.0000   Min.   :0.000   Min.   :0.0000  
##  1st Qu.:1.000   1st Qu.:0.0000   1st Qu.:2.000   1st Qu.:0.0000  
##  Median :1.000   Median :0.0000   Median :2.000   Median :1.0000  
##  Mean   :1.399   Mean   :0.7294   Mean   :2.314   Mean   :0.5446  
##  3rd Qu.:2.000   3rd Qu.:1.0000   3rd Qu.:3.000   3rd Qu.:1.0000  
##  Max.   :2.000   Max.   :4.0000   Max.   :3.000   Max.   :1.0000

1.3 Preprocesado y gestión de características

1.3.1 Valores nulos del conjunto de los datos

Estadísticas de valores vacíos del primer juego de datos

colSums(is.na(datos1))
##            Age            Sex  ChestPainType      RestingBP    Cholesterol      FastingBS     RestingECG          MaxHR ExerciseAngina        Oldpeak       ST_Slope 
##              0              0              0              0              0              0              0              0              0              0              0 
##   HeartDisease 
##              0
colSums(datos1=="")
##            Age            Sex  ChestPainType      RestingBP    Cholesterol      FastingBS     RestingECG          MaxHR ExerciseAngina        Oldpeak       ST_Slope 
##              0              0              0              0              0              0              0              0              0              0              0 
##   HeartDisease 
##              0

Estadísticas de valores vacíos del segundo juego de datos

colSums(is.na(datos2))
##   ï..age      sex       cp trestbps     chol      fbs  restecg  thalach    exang  oldpeak    slope       ca     thal   target 
##        0        0        0        0        0        0        0        0        0        0        0        0        0        0
colSums(datos2=="")
##   ï..age      sex       cp trestbps     chol      fbs  restecg  thalach    exang  oldpeak    slope       ca     thal   target 
##        0        0        0        0        0        0        0        0        0        0        0        0        0        0

Como se puede comprobar, tenemos la “suerte” de no tener ningún valor nulo o vacío en los dos juegos de datos.

1.3.2 Normalización del conjunto de los datos

Ahora que hemos comprobado que no tenemos valores nulos, se va a proceder a la normalización de los dos conjuntos de datos. La importancia de este proceso es para que a la hora de juntar los dos juegos de datos estén todos en la misma escala de valores y que así se pueda hacer un merge limpio y rápido.

Para la normalización, se hará un análisis de las características comunes comparando una por una de cada uno de los conjuntos de datos. Además, una vez normalizado se analizarán las características para ver posibles valores incorrectos y poder corregirlos.

  • EDAD

Como se puede comprobar en las estadísticas del primer conjunto de datos las edades van desde los 28 hasta los 77 años, mientras que en el segundo van desde los 29 hasta los 77 años.

#Histograma de la característica edad del primer conjunto de datos 
h1 <- hist(datos1$Age, xlab="Edad", col="ivory", ylab="Cantidad", main="EDAD EN EL PRIMER JUEGO DE DATOS", ylim = c(0, 225), xlim = c(20,80))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))

#Histograma de la característica edad del segundo conjunto de datos 
h2 <- hist(datos2$ï..age, xlab="Edad", col="ivory", ylab="Cantidad", main="EDAD EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0, 80), xlim = c(20,80))
text(h2$mids,h2$counts,labels=h2$counts, adj=c(0.5, -0.5))

Como se puede observar, la franja de entre los 50 y 60 años son donde más datos existen, mientras que los extremos donde menos datos.

Una diferencia bastante clara es en la franja de entre los 40 y 45 años, que en el primer conjunto de datos hay un crecimiento de los datos de manera progresiva, mientras que en el segundo existen un crecimiento notable de los datos bastante peculiar en ese rango.

  • SEXO

En esta característica observamos que en primer conjunto de datos están identificado con las variables M (hombre) y F (mujer) mientras que en el segundo juego de datos tenemos 1 (hombre) y 0 (mujer).

Entonces se va a normalizar el primer conjunto de datos para que sea como el segundo, vamos a definir el valor 1 para el hombre y el valor 0 para la mujer.

#Cambiamos las letras por los números
datos1$Sex [datos1$Sex == "M"] <- 1
datos1$Sex [datos1$Sex == "F"] <- 0

#Pasamos de carácter a numérico
datos1$Sex <- as.numeric(datos1$Sex)

Una vez normalizada la característica , analizamos el conjunto de los datos contemplados en esta.

#Histograma de la característica sexo del primer conjunto de datos 
h1 <- hist(datos1$Sex, xlab="Sexo", col=c("ivory", "lightcyan"), ylab="Cantidad", main="SEXO EN EL PRIMER JUEGO DE DATOS", breaks = 2, ylim = c(0, 750), axes = FALSE)
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("Mujeres","Hombres" ))
axis(2)

#Histograma de la característica sexo del segundo conjunto de datos 
h2 <-hist(datos2$sex, xlab="Sexo", col=c("ivory", "lightcyan"), ylab="Cantidad", main="SEXO EN EL SEGUNDO JUEGO DE DATOS", breaks = 2, ylim = c(0, 250), axes = FALSE)
text(h2$mids,h2$counts,labels=h2$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("Mujeres","Hombres" ))
axis(2)

Tras la normalización y la exploración de los datos, nos damos cuenta de que existen mas registros de hombres que de mujeres en los dos conjuntos de datos.

  • TIPO DE DOLOR TORÁCICO (ChestPainType, cp)

Nos damos cuenta de que el primer conjunto de datos viene identificado por 4 variables categóricas (TA: angina típica, ATA: angina atípica, NAP: dolor no anginal, ASY: asintomático) mientras en el segundo conjunto de datos por valores numérico y cada valor asignado a una causa (valor 0: angina típica, valor 1: angina atípica, valor 2: dolor no anginoso, valor 3: asintomático).

La normalización se hará para el primer conjunto de datos, asignando los valores (que son los del segundo conjunto de datos) de la siguiente manera:

+ 0 = TA
+ 1 = ATA
+ 2 = NAP
+ 3 = ASY
#Cambiamos las letras por los números
datos1$ChestPainType [datos1$ChestPainType == "TA"]  <- 0
datos1$ChestPainType [datos1$ChestPainType == "ATA"] <- 1
datos1$ChestPainType [datos1$ChestPainType == "NAP"] <- 2
datos1$ChestPainType [datos1$ChestPainType == "ASY"] <- 3

#Pasamos de carácter a numérico
datos1$ChestPainType <- as.numeric(datos1$ChestPainType)

Una vez normalizada la característica , analizamos el conjunto de los datos contemplados en esta.

#Histograma de la característica Tipo de dolor torácico del primer conjunto de datos 
h1 <- hist(datos1$ChestPainType, xlab="Tipo de dolor torácico", col= c("ivory", "lightcyan", "ORANGE", "PINK"), ylab="Cantidad", main="TIPO DOLOR TORÁCICO EN EL PRIMER JUEGO DE DATOS", ylim = c(0, 550),axes = FALSE, breaks=seq(min(datos1$ChestPainType)-0.5, max(datos1$ChestPainType)+0.5, by=1) )
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0,1,2,3), cex.axis=1, labels = c("Angina típica", "Angina atípica","Dolor no anginal", "Asintomático" ))
axis(2)

#Histograma de la característica Tipo de dolor torácico del segundo conjunto de datos 
h2 <- hist(datos2$cp, xlab="Tipo de dolor torácico", col= c("ivory", "lightcyan", "ORANGE", "PINK"), ylab="Cantidad", main="TIPO DOLOR TORÁCICO EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0, 160),axes = FALSE, breaks=seq(min(datos2$cp)-0.5, max(datos2$cp)+0.5, by=1) )
text(h2$mids,h2$counts,labels=h2$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.2,0.85,1.75,2.75), cex.axis=1, labels = c("Angina típica", "Angina atípica","Dolor no anginal", "Asintomático" ))
axis(2)

Como se puede comprobar, en los dos conjuntos de datos tenemos diversas proporciones del tipo de dolor torácico, lo que supone tener mas variedad a la hora de poder sacar conclusiones.

  • PRESIÓN ARTERIAL EN REPOSO (RestingBP y trestbps)

Como se muestran en las estadísticas esta característica son de tipo numérico y en el primer conjunto de datos va desde 0 hasta 200 y en el segundo de 94 a 200.

Como se puede apreciar, tener una presión arterial de 0 es estar considerado muerto, por lo que considero que el valor 0 es un valor nulo.

Lo primero que se va a hacer es obtener el número de casos que la presión arterial es 0, y se consideraran las diversas formas de tratar estos datos.

#Veces que aparece el valor cero en la presion arterial
length(datos1$RestingBP[datos1$RestingBP == 0])
## [1] 1

Como solo aparece una vez, se le asignará un valor por defecto. El valor por defecto será el más común.

#Función para calcular el valor más común
common_value <- function(x) {
uniqx <- unique(na.omit(x))
uniqx[which.max(tabulate(match(x, uniqx)))]
}

#Calculamos el valor más comun
BP_comun <- common_value(datos1$RestingBP)

#Asignamos el valor
datos1$RestingBP[datos1$RestingBP == 0] <- BP_comun

#vemos las estaditicas del dato
summary(datos1$RestingBP)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    80.0   120.0   130.0   132.5   140.0   200.0

Ahora ya tenemos los valores entre 80 y 200 que son un rango normal para estos valores.

#Histograma de la característica Presión Arterial del primer conjunto de datos 
h1 <- hist(datos1$RestingBP, xlab="Presión Arterial", col="ivory", ylab="Cantidad", main="PRESIÓN ARTERIAL EN REPOSO EN EL PRIMER JUEGO DE DATOS", ylim = c(0, 225), xlim = c(80,200))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))

#Histograma de la característica Presión Arterial del segundo conjunto de datos 
h1 <- hist(datos2$trestbps, xlab="Presión Arterial", col="ivory", ylab="Cantidad", main="PRESIÓN ARTERIAL EN REPOSO EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0, 100), xlim = c(80,200))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))

Se puede observar que el grueso de los datos está entre 100 y 160 en los dos conjuntos de datos.

  • COLESTEROL (Cholesterol y chol)

La siguiente característica en ambos conjuntos de datos es de tipo numérico. Al igual que en la presión arterial en reposo, en el primer data set tenemos valores 0 que debemos analizar, mientras que en el segundo data set tenemos datos que abarcan desde el 126 hasta 564.

Lo primero que se va a hacer es obtener el numero de casos que el coresterol es 0, y se consideraran las diversas formas de tratar estos datos.

#Veces que aparece el valor cero en la presion arterial
length(datos1$RestingBP[datos1$Cholesterol == 0])
## [1] 172

Esta vez tenemos 172 casos en lo que ocurre esto (equivale a un 18% de los casos totales). Antes de ver que valor se le asignan, se va a graficar los datos para ver de manera grafica que opción tomar: el valor medio o el más común.

#Histograma de la característica Coresterol del primer conjunto de datos 
h1 <- hist(datos1$Cholesterol, xlab="Coresterol", col="ivory", ylab="Cantidad", main="CORESTEROL EN EL PRIMER JUEGO DE DATOS SIN TRATAR NULOS", ylim = c(0,300), xlim = c(0, 700))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))

#Histograma de la característica Coresterol del segundo conjunto de datos 
h1 <- hist(datos2$chol, xlab="Coresterol", col="ivory", ylab="Cantidad", main="CORESTEROL EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0,150), xlim = c(0, 700))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))

Tras analizar la gráfica y para no perder estos datos, se le asignaran un valor por defecto, que será la media de los datos. Esta decisión se ha tomado ya que poner el más común, nos crearía un conjunto de datos muy distintos entre unas medidas y otras, mientras que poner la media sería un valor que tenga en cuenta el grueso de todos los datos.

#Calculamos el valor más comun
coresterol_media <- mean(datos1$Cholesterol)

#Asignamos el valor truncado para evitar decimales
datos1$Cholesterol[datos1$Cholesterol == 0] <- trunc(coresterol_media)

#vemos las estaditicas del dato
summary(datos1$RestingBP)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    80.0   120.0   130.0   132.5   140.0   200.0

Ahora ya tenemos los valores entre 80 y 200 que son un rango normal para estos valores.

#Histograma de la característica Coresterol del primer conjunto de datos 
h1 <- hist(datos1$Cholesterol, xlab="Coresterol", col="ivory", ylab="Cantidad", main="CORESTEROL EN EL PRIMER JUEGO DE DATOS", ylim = c(0,330), xlim = c(0, 700))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))

#Histograma de la característica Coresterol del segundo conjunto de datos 
h1 <- hist(datos2$chol, xlab="Coresterol", col="ivory", ylab="Cantidad", main="CORESTEROL EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0,150), xlim = c(0, 700))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))

  • NIVEL DE AZÚCAR EN SANGRE EN AYUNAS (FastingBS y fbs)

Como se puede comprobar el conjunto de los datos puedes ser 1 o 0, es decir verdadero o falso si se cumple la siguiente condición: si nivel de azúcar en sangre en ayunas> 120 mg / dl.

En esta característica no tenemos valores nulos, así que vamos a ver la distribución de las dos opciones.

#Histograma de la característica Azúcar en sangre en ayunas del primer conjunto de datos 
h1 <- hist(datos1$FastingBS, xlab="¿Azúcar en sangre en ayunas> 120 mg / dl?", col=c("ivory", "lightcyan"), ylab="Cantidad", main="NIVEL DE AZÚCAR EN EL PRIMER JUEGO DE DATOS", breaks = 2, ylim = c(0, 750), axes = FALSE)
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("NO","SI" ))
axis(2)

#Histograma de la característica Azúcar en sangre en ayunas del segundo conjunto de datos 
h2 <-hist(datos2$fbs, xlab="¿Azúcar en sangre en ayunas> 120 mg / dl?", col=c("ivory", "lightcyan"), ylab="Cantidad", main="NIVEL DE AZÚCAR EN EL SEGUNDO JUEGO DE DATOS", breaks = 2, ylim = c(0, 280), axes = FALSE)
text(h2$mids,h2$counts,labels=h2$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("NO","SI" ))
axis(2)

Se puede comprobar que hay mas casos que NO se cumple esa condición de que SÍ.

  • ECG EN REPOSO (RestingECG y restecg)

En el primer conjunto de datos tenemos diferentes parámetros que esta característica puede tomar:

 + Normal: Normal, 
 + ST: con anomalía de la onda ST-T
 + LVH: que muestra una hipertrofia ventricular izquierda probable o definitiva según los criterios de Estes.

En el segundo conjunto de datos, los diferentes parámetros que esta característica puede tomas son:

+ 0 = normal
+ 1 = con anomalía de la onda ST-T
+ 2 = mostrando hipertrofia ventricular izquierda probable o definitiva según los criterios de Estes.

Para normalizar los dos conjuntos de datos, se cambiará los valores del primer conjunto de datos para que sean equivalentes al segundo.

#Cambiamos las letras por los números
datos1$RestingECG [datos1$RestingECG == "Normal"]  <- 0
datos1$RestingECG [datos1$RestingECG == "ST"] <- 1
datos1$RestingECG [datos1$RestingECG == "LVH"] <- 2

#Pasamos de carácter a numérico
datos1$RestingECG <- as.numeric(datos1$RestingECG)

Una vez normalizada la característica , analizamos el conjunto de los datos contemplados en esta.

#Histograma de la característica ECG en reposo del primer conjunto de datos 
h1 <- hist(datos1$RestingECG, xlab="ECG en reposo", col= c("ivory", "lightcyan", "ORANGE"), ylab="Cantidad", main="ECG EN REPOSO EN EL PRIMER JUEGO DE DATOS", ylim = c(0, 600), axes = FALSE, breaks=seq(min(datos1$RestingECG)-0.5, max(datos1$RestingECG)+0.5, by=1) )
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75, 1.75 ), cex.axis=1, labels = c("Normal","ST", "LVH"))
axis(2)

#Histograma de la característica ECG en reposo del segundo conjunto de datos 
h1 <- hist(datos2$restecg, xlab="ECG en reposo", col= c("ivory", "lightcyan", "ORANGE"), ylab="Cantidad", main="ECG EN REPOSO EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0, 160), axes = FALSE,breaks=seq(min(datos2$restecg)-0.5, max(datos2$restecg)+0.5, by=1) )
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75, 1.75 ), cex.axis=1, labels = c("Normal","ST", "LVH"))
axis(2)

Como se puede contemplar en el primer conjunto de datos los valores HVI es el segundo grupo con más registros, y en el segundo supone un conjunto muy bajo de todas las muestras mientras que las otras dos opciones están muy igualadas.

  • FRECUENCIA CARDÍACA MÁXIMA (MaxHR, thalach)

Dicha característica es de carácter numérica y en el primer conjunto de datos contempla valores desde el 60 al 202 y en el segundo desde el 71 hasta el 202.

#Histograma de la característica Frecuencia Cardíaca Máxima del primer conjunto de datos 
h1 <- hist(datos1$MaxHR, xlab="Frecuencia Cardíaca Máxima", col="ivory", ylab="Cantidad", main="FRECUENCIA CARDÍACA MÁXIMA EN EL PRIMER JUEGO DE DATOS", ylim = c(0,140), axes = FALSE)
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(60, 70, 80,90,100,110,120,130,140,150,160,170,180,190,200,210), cex.axis=1)
axis(2)

#Histograma de la característica Frecuencia Cardíaca Máxima del segundo conjunto de datos 
h1 <- hist(datos2$thalach, xlab="Frecuencia Cardíaca Máxima", col="ivory", ylab="Cantidad", main="FRECUENCIA CARDÍACA MÁXIMA EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0,60), axes = FALSE)
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(60, 70, 80,90,100,110,120,130,140,150,160,170,180,190,200,210), cex.axis=1)
axis(2)

Se puede comprobar que los extremos en los dos conjuntos de datos tienen menos valores, y que el grueso de las muestras se encuentran entre los valores centrales (desde 100 a 180).

  • ANGINA INDUCIDA POR EJERCICIO (ExerciseAngina, exang)

En el primer conjunto de datos tiene los valores Y: Sí, N: No, mientras que en el segundo 1 = sí; 0 = no.

Al igual que se ha hecho con otras características, se normalizará el primer conjunto a favor del segundo conjunto de datos.

#Cambiamos las letras por los números
datos1$ExerciseAngina [datos1$ExerciseAngina == "N"]  <- 0
datos1$ExerciseAngina [datos1$ExerciseAngina == "Y"]  <- 1

#Pasamos de carácter a numérico
datos1$ExerciseAngina <- as.numeric(datos1$ExerciseAngina)

Una vez normalizada la característica , analizamos el conjunto de los datos contemplados en esta.

#Histograma de la característica Angina inducida por ejercicio del primer conjunto de datos
h1 <- hist(datos1$ExerciseAngina, xlab="¿Angina inducida por ejercicio?", col=c("ivory", "lightcyan"), ylab="Cantidad", main="ANGINA INDUCIDA POR EJERCICIO EN EL PRIMER JUEGO DE DATOS", breaks = 2, ylim = c(0, 600), axes = FALSE)
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("NO","SI" ))
axis(2)

#Histograma de la característica Angina inducida por ejercicio del segundo conjunto de datos
h2 <-hist(datos2$exang, xlab="¿Angina inducida por ejercicio?", col=c("ivory", "lightcyan"), ylab="Cantidad", main="ANGINA INDUCIDA POR EJERCICIO EN EL SEGUNDO JUEGO DE DATOS", breaks = 2, ylim = c(0, 220), axes = FALSE)
text(h2$mids,h2$counts,labels=h2$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("NO","SI" ))
axis(2)

Como se puede apreciar, hay mas casos en que NO se ha producido una angina inducida por el ejercicio de que Si se haya producido en los dos conjuntos de datos.

  • OLDPEAK

Esta característica de tipo numérica puede abarcar valores negativos hasta (en el caso del primer conjunto) hasta un máximo de un valor igual a 6,2 (en ambos conjuntos de datos)

#Histograma de la característica Oldpeak del primer conjunto de datos
h1 <- hist(datos1$Oldpeak, xlab="Oldpeak", col="ivory", ylab="Cantidad", main="OLDPEAK EN EL PRIMER JUEGO DE DATOS", ylim = c(0,400), xlim = c(-4, 8))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))

#Histograma de la característica Oldpeak del segundo conjunto de datos
h1 <- hist(datos2$oldpeak, xlab="Oldpeak", col="ivory", ylab="Cantidad", main="OLDPEAK EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0,150), xlim = c(0, 8))
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))

Se puede comprobar que el grueso de las muestras se encuentra entre los valores centrales en el primer caso mientras que en el segundo juego de datos los valores iniciales tienen mas muestras. Observar que en el segundo conjunto tiene rango de valores positivos, mientras que en el primer conjunto de datos abarca un rango mas amplio.

  • PENDIENTE DEL SEGMENTO ST (ST_Slope, pendiente)

Como ocurría en otras características anteriores cada conjunto de datos los mide de una manera distinta, siendo en el primer conjunto:

+ Up: uploping
+ Flat: flat
+ Down: downsloping

Y en el segundo conjunto de datos:

+ Valor 0: pendiente ascendente
+ Valor 1: plano
+ Valor 2: pendiente descendente

Y como se ha realizado antes, se normalizará el primer conjunto a favor del segundo.

#Cambiamos las letras por los números
datos1$ST_Slope [datos1$ST_Slope == "Up"]   <- 0
datos1$ST_Slope [datos1$ST_Slope == "Flat"] <- 1
datos1$ST_Slope [datos1$ST_Slope == "Down"] <- 2

#Pasamos de carácter a numérico
datos1$ST_Slope <- as.numeric(datos1$ST_Slope)

Una vez normalizada la característica , analizamos el conjunto de los datos contemplados en esta.

#Histograma de la característica Pendiente del segmento ST del primer conjunto de datos
h1 <- hist(datos1$ST_Slope, xlab="Pendiente del segmento ST", col= c("ivory", "lightcyan", "ORANGE"), ylab="Cantidad", main="PENDIENTE DEL SEGMENTO ST EN EL PRIMER JUEGO DE DATOS", ylim = c(0, 500), axes = FALSE,breaks=seq(min(datos1$ST_Slope)-0.5, max(datos1$ST_Slope)+0.5, by=1) )
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75,1.75), cex.axis=1, labels = c("Ascendente","Plano", "Descendente"))
axis(2)

#Histograma de la característica Pendiente del segmento ST del segundo conjunto de datos
h1 <- hist(datos2$slope, xlab="Pendiente del segmento ST", col= c("ivory", "lightcyan", "ORANGE"), ylab="Cantidad", main="PENDIENTE DEL SEGMENTO ST EN EL SEGUNDO JUEGO DE DATOS", ylim = c(0, 160), axes = FALSE,breaks=seq(min(datos2$slope)-0.5, max(datos2$slope)+0.5, by=1) )
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75,1.75), cex.axis=1, labels = c("Ascendente","Plano", "Descendente"))
axis(2)

El caso más común de ambos conjuntos es que la pendiente sea plana, sin embargo en el primer conjunto la tendencia del segundo caso más común es ascendente y en el segundo conjunto descendente. Esto es bastante bueno ya que nos permite tener una visión mas amplia de todos los tipos de pendientes.

  • ¿ENFERMEDAD CARDIACA? (HeartDisease, target)

En los dos conjuntos de datos tienen normalizada la salida usando el valor 1: enfermedad cardíaca, y el valor 0: Normal.

#Histograma de la característica¿Enfermedad Cardiaca? del primer conjunto de datos
h1 <- hist(datos1$HeartDisease, xlab="¿Enfermedad Cardiaca?", col=c("ivory", "lightcyan"), ylab="Cantidad", main="¿ENFERMEDAD CARDIACA? EN EL PRIMER JUEGO DE DATOS", breaks = 2, ylim = c(0, 600), axes = FALSE)
text(h1$mids,h1$counts,labels=h1$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("NO","SI" ))
axis(2)

#Histograma de la característica ¿Enfermedad Cardiaca? del segundo conjunto de datos
h2 <-hist(datos2$target, xlab="¿Enfermedad Cardiaca?", col=c("ivory", "lightcyan"), ylab="Cantidad", main="¿ENFERMEDAD CARDIACA? EN EL SEGUNDO JUEGO DE DATOS", breaks = 2, ylim = c(0, 220), axes = FALSE)
text(h2$mids,h2$counts,labels=h2$counts, adj=c(0.5, -0.5))
axis(1, at =c(0.25, 0.75), cex.axis=1, labels = c("NO","SI" ))
axis(2)

Como se puede observar hay mas casos en que SI hay enfermedad cardiaca que caso en los que NO hay.

1.3.3 Tratamiento características distintas

Antes se ha mencionado que el segundo conjunto tiene dos características presentes que el primer conjunto no tiene. Haciendo un análisis de las estadísticas y la definición de dada al principio de cada una de las dos características, se ha decidió descartarlas por las siguientes razones:

 + Si se quieren tener en cuenta tendremos casi el 75 % de valores nulos.
 + En el caso del numero de vasos afectado (CA) es algo especial para cada caso y no se puede obtener similitudes con otros casos.
 + La Talasemia tampoco se puede calcular la cantidad que tiene a través de otros campos.

Una vez que tenemos todas las características de los dos conjuntos con la misma normalización, se va a juntar los dos conjuntos de datos en uno solo.

1.4 Construcción de conjunto de datos final

1.4.1 Normalización de nombres de columnas

Lo primero es la normalización de los nombre de las columnas de los dos conjunto de datos

#Obtenemos el nombre de las columnas del primer conjunto de datos
colnames(datos1)
##  [1] "Age"            "Sex"            "ChestPainType"  "RestingBP"      "Cholesterol"    "FastingBS"      "RestingECG"     "MaxHR"          "ExerciseAngina"
## [10] "Oldpeak"        "ST_Slope"       "HeartDisease"
#Renombramos las columnas del primer conjunto de datos

colnames(datos1)[1]<-  "EDAD"
colnames(datos1)[2]<-  "SEXO"
colnames(datos1)[3]<-  "TIPO DOLOR TORAX"
colnames(datos1)[4]<-  "PRESIÓN ARTERIAL"
colnames(datos1)[5]<-  "CORESTEROL"
colnames(datos1)[6]<-  "NIVEL DE AZÚCAR"
colnames(datos1)[7]<-  "ECG EN REPOSO"
colnames(datos1)[8]<-  "FREC CARDÍACA MÁX"
colnames(datos1)[9]<-  "ANGINA x EJERCICIO"
colnames(datos1)[10]<- "OLDPEAK"
colnames(datos1)[11]<- "PENDIENTE ST"
colnames(datos1)[12]<- "E. CARDIACA"


#Vemos el nombre de las columnas del primer conjunto de datos
colnames(datos1)
##  [1] "EDAD"               "SEXO"               "TIPO DOLOR TORAX"   "PRESIÓN ARTERIAL"   "CORESTEROL"         "NIVEL DE AZÚCAR"    "ECG EN REPOSO"     
##  [8] "FREC CARDÍACA MÁX"  "ANGINA x EJERCICIO" "OLDPEAK"            "PENDIENTE ST"       "E. CARDIACA"
#Obtenemos el nombre de las columnas del segundo conjunto de datos
colnames(datos2)
##  [1] "ï..age"   "sex"      "cp"       "trestbps" "chol"     "fbs"      "restecg"  "thalach"  "exang"    "oldpeak"  "slope"    "ca"       "thal"     "target"
#Renombramos las columnas del primer segundo de datos

colnames(datos2)[1]<-  "EDAD"
colnames(datos2)[2]<-  "SEXO"
colnames(datos2)[3]<-  "TIPO DOLOR TORAX"
colnames(datos2)[4]<-  "PRESIÓN ARTERIAL"
colnames(datos2)[5]<-  "CORESTEROL"
colnames(datos2)[6]<-  "NIVEL DE AZÚCAR"
colnames(datos2)[7]<-  "ECG EN REPOSO"
colnames(datos2)[8]<-  "FREC CARDÍACA MÁX"
colnames(datos2)[9]<-  "ANGINA x EJERCICIO"
colnames(datos2)[10]<- "OLDPEAK"
colnames(datos2)[11]<- "PENDIENTE ST"
colnames(datos2)[14]<- "E. CARDIACA"

#Eliminamos las colunmas que no vamos a usar
datos2$ca <- NULL
datos2$thal <- NULL

#Vemos el nombre de las columnas del primer conjunto de datos
colnames(datos2)
##  [1] "EDAD"               "SEXO"               "TIPO DOLOR TORAX"   "PRESIÓN ARTERIAL"   "CORESTEROL"         "NIVEL DE AZÚCAR"    "ECG EN REPOSO"     
##  [8] "FREC CARDÍACA MÁX"  "ANGINA x EJERCICIO" "OLDPEAK"            "PENDIENTE ST"       "E. CARDIACA"

1.4.2 Fusión de los conjuntos de datos

#Fusionamos los dos conjuntos de datos
datos_final <- merge(x=datos1, y=datos2, all = TRUE)

#Verificamos la estructura del segundo juego
str(datos_final)
## 'data.frame':    1221 obs. of  12 variables:
##  $ EDAD              : int  28 29 29 29 29 30 31 31 32 32 ...
##  $ SEXO              : num  1 1 1 1 1 0 0 1 0 1 ...
##  $ TIPO DOLOR TORAX  : num  1 1 1 1 1 0 1 3 1 0 ...
##  $ PRESIÓN ARTERIAL  : int  130 120 130 130 140 170 100 120 105 95 ...
##  $ CORESTEROL        : num  132 243 204 204 263 237 219 270 198 198 ...
##  $ NIVEL DE AZÚCAR   : int  0 0 0 0 0 0 0 0 0 1 ...
##  $ ECG EN REPOSO     : num  2 0 0 2 0 1 1 0 0 0 ...
##  $ FREC CARDÍACA MÁX : int  185 160 202 202 170 170 150 153 165 127 ...
##  $ ANGINA x EJERCICIO: num  0 0 0 0 0 0 0 1 0 0 ...
##  $ OLDPEAK           : num  0 0 0 0 0 0 0 1.5 0 0.7 ...
##  $ PENDIENTE ST      : num  0 0 2 0 0 0 0 1 0 0 ...
##  $ E. CARDIACA       : int  0 0 1 0 0 0 0 1 0 1 ...
#Estadísticas básicas
summary(datos_final)
##       EDAD            SEXO        TIPO DOLOR TORAX PRESIÓN ARTERIAL   CORESTEROL    NIVEL DE AZÚCAR  ECG EN REPOSO    FREC CARDÍACA MÁX ANGINA x EJERCICIO
##  Min.   :28.00   Min.   :0.0000   Min.   :0.000    Min.   : 80.0    Min.   : 85.0   Min.   :0.0000   Min.   :0.0000   Min.   : 60       Min.   :0.0000    
##  1st Qu.:47.00   1st Qu.:1.0000   1st Qu.:1.000    1st Qu.:120.0    1st Qu.:198.0   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:122       1st Qu.:0.0000    
##  Median :54.00   Median :1.0000   Median :2.000    Median :130.0    Median :228.0   Median :0.0000   Median :0.0000   Median :141       Median :0.0000    
##  Mean   :53.72   Mean   :0.7633   Mean   :1.933    Mean   :132.3    Mean   :238.5   Mean   :0.2121   Mean   :0.5848   Mean   :140       Mean   :0.3849    
##  3rd Qu.:60.00   3rd Qu.:1.0000   3rd Qu.:3.000    3rd Qu.:140.0    3rd Qu.:269.0   3rd Qu.:0.0000   3rd Qu.:1.0000   3rd Qu.:160       3rd Qu.:1.0000    
##  Max.   :77.00   Max.   :1.0000   Max.   :3.000    Max.   :200.0    Max.   :603.0   Max.   :1.0000   Max.   :2.0000   Max.   :202       Max.   :1.0000    
##     OLDPEAK         PENDIENTE ST     E. CARDIACA    
##  Min.   :-2.6000   Min.   :0.0000   Min.   :0.0000  
##  1st Qu.: 0.0000   1st Qu.:0.0000   1st Qu.:0.0000  
##  Median : 0.6000   Median :1.0000   Median :1.0000  
##  Mean   : 0.9251   Mean   :0.8272   Mean   :0.5512  
##  3rd Qu.: 1.6000   3rd Qu.:1.0000   3rd Qu.:1.0000  
##  Max.   : 6.2000   Max.   :2.0000   Max.   :1.0000
#Comprobar valores nulos
plot_missing(datos_final)

Podemos concluir que el nuevo juego de datos tiene las siguientes características:

  • Edad: la edad de la persona en años.

  • Sexo: el sexo de la persona. Los valores que puede tomar son:

    • 1 = hombre.
    • 0 = mujer.
  • Tipo de dolor Torax: tipo de dolor torácico experimentado. Los valores que puede tomar son:

    • 0 = Angina típica.
    • 1 = Angina atípica.
    • 2 = Dolor no anginoso.
    • 3 = Asintomático.
  • Presión arterial: la presión arterial en reposo de la persona (medido en mm/Hg) al ingreso en el hospital.

  • Colesterol: colesterol sérico de la persona [medido eb mm/dl]

  • Nivel de azúcar en sangre: estando el paciente en ayunas. Los valores que puede tomar son dada la siguiente condición < 120 mg/dl>> son:

    • 1 = Verdadero.
    • 0 = Falso.
  • ECG en reposo: resultados del electrocardiograma en reposo. Los valores que puede tomar son:

    • 0 = Normal.
    • 1 = Con anomalía de la onda ST-T.
    • 2 = Mostrando hipertrofia ventricular izquierda probable o definitiva según los criterios de Estes.
  • Frec cardíaca max: frecuencia cardíaca máxima alcanzada por la persona.

  • Angina x ejercicio: si se ha producido una angina al realizar ejercicio. Los valores que puede tomar son:

    • 1 = Sí.
    • 0 = No.
  • Oldpeak: depresión del ST inducida por el ejercicio en relación con el reposo.

  • Pendiente ST: la pendiente del segmento ST de ejercicio pico. Los valores que puede tomar son:

    • 0 = Pendiente Ascendente.
    • 1 = Plano.
    • 2 = Pendiente Descendente.
  • ¿E. Cardíaca?: si la persona tiene alguna enfermedad cardíaca. Los valores que puede tomar son:

    • 1 = Sí.
    • 0 = No.

1.4.3 Análisis exploratorio del nuevo conjunto de datos

Una vez descrito el nuevo juego de datos, se va a generar histogramas para verificar la distribución de las variables.

library(purrr)
library(tidyr)
library(ggplot2)

datos_final %>%
  keep(is.numeric) %>% 
  gather() %>% 
  ggplot(aes(value)) +
    facet_wrap(~ key, scales = "free") +
    geom_histogram(col="red",
                   fill="green",
                   alpha = 0.5,) +
    ggtitle("Distribuciones de las variables numéricas")

NOMBRE VARIABLE DISTRIBUCIÓN EXPLICACIÓN
ANGINA x EJERCICIO Normal Hay mas casos en que la angina no ha sido inducida por ejercicio
CORESTEROL Sesgado a la derecha Cifras más “bajas” tienen más registros que cifras más altas
E. CARDIACA Normal Hay más casos en que se tiene una enfermedad cardiaca
ECG EN REPOSO Sesgado a la derecha Casos normales tienen mayor peso que con alguna patología
EDAD Normal Hay más casos en personas con mediana edad que en los extremos
FREC CARDÍACA MÁX Normal Frecuencia de los datos entre rangos intermedios
NIVEL DE AZÚCAR Sesgado a la derecha Hay más casos en que se tiene el nivel bien
OLDPEAK Sesgado a la derecha Existe un grupo con una diferencia bastante grande que con el resto de los datos
PENDIENTE ST Normal Más casos con pendiente normal que alterada
PRESIÓN ARTERIAL Normal Frecuencia de los datos entre rangos intermedios
SEXO Sesgado a la izquierda Hay más pacientes hombres que mujeres
TIPO DOLOR TORAX Sesgado a la izquierda Hay más casos asintomáticos

Solo 5 de las doce características tienen una distribución normal, aunque debemos contemplar que alguna de las características está normalizada para tratar dos o tres valores que esas características pueden tener, teniendo en cuenta esto ultimo podemos decir que las únicas dos características que tienen distribuciones distintas son: Colesterol y Oldpeak.

Para comprobar que estamos en los cierto en las dos características con distribución sesgada (Colesterol y Oldpeak) se va a realizar test de normalidad para verificar y con la “función qqnorm” podríamos hacer un Q-Q plot para ver si una variable determinada tiene una distribución normal.

#Colesterol
qqnorm(datos_final$CORESTEROL);qqline(datos_final$CORESTEROL, col = 2)

#Oldpeak
qqnorm(datos_final$OLDPEAK);qqline(datos_final$OLDPEAK, col = 2)

El procedimiento que se puede seguir cuando tenemos una variable que no sigue una distribución normal es la de aplicar el logaritmo a la variable. Lo verificamos de la siguiente manera para las dos características: Colesterol y Oldpeak.

#Coresterol 
Coresterol_log<- log(datos_final$CORESTEROL)
ggplot(datos_final, aes(x = Coresterol_log)) + geom_histogram() + xlab("CORESTEROL")

#Oldpeak. 
Oldpeak_log<- log(datos_final$OLDPEAK)
ggplot(datos_final, aes(x = Oldpeak_log)) + geom_histogram() + xlab("OLDPEAK")

Observamos como ahora cambia las distribuciones. Lo comprobamos con el Q-Q plot para confirmarlo.

#Colesterol
qqnorm(datos_final$CORESTEROL);qqline(datos_final$CORESTEROL, col = 2)

#Oldpeak
qqnorm(datos_final$OLDPEAK);qqline(datos_final$OLDPEAK, col = 2)

Los test de normalidad no son los esperados, así que se mantendrán estos valores tal y como están. Y continuamos con el análisis exploratorio del nuevo conjunto de datos.

A continuación, se va a representar los niveles de ciertas características en relación con otras

#Relación de la Edad, la Presión arterial y la Frecuencia Cardiaca Máxima.
datos_final %>%
  ggplot(aes(x=EDAD,y=`PRESIÓN ARTERIAL`,color=`FREC CARDÍACA MÁX`))+
  geom_point(alpha=0.7)+xlab("EDAD") +
  ylab("PRESIÓN ARTERIAL")+
  ggtitle("Relación de la Edad, la Presión arterial y la Frecuencia Cardiaca Máxima")

#Relación de la Edad, el Coresterol y la Frecuencia Cardiaca máxima.
datos_final %>%
  ggplot(aes(x=EDAD,y=CORESTEROL,color=`FREC CARDÍACA MÁX`))+
  geom_point(alpha=0.7)+xlab("EDAD") +
  ylab("CORESTEROL")+
  ggtitle("Relación de la Edad, el Oldpeak y la Frecuencia Cardiaca Máxima")

#Relación de la Edad, el Coresterol y la Frecuencia Cardiaca máxima.
datos_final %>%
  ggplot(aes(x=EDAD,y=OLDPEAK,color=`FREC CARDÍACA MÁX`))+
  geom_point(alpha=0.7)+xlab("EDAD") +
  ylab("OLDPEAK")+
  ggtitle("Relación de la Edad, el Oldpeak y la Frecuencia Cardiaca Máxima")

Gracias a estas representaciones se pueden ver las relaciones entre unas características y otras.

Por ultimo se va a mirar a través de los diagramas de cajas el rango de las características enfrentado a si un paciente tiene una enfermedad cardiaca o no.

#Diagrama de caja de todas las características enfrentadas a si un paciente tiene enfermedad cardiaca
plot_boxplot(datos_final, by = "E. CARDIACA")

1.4.4 Correlaciones

Una vez realizado el análisis exploratorio, se va a realizar las correlaciones de las características

#Calculamos las correlaciones
cor_datos <- cor(datos_final)
cor_datos
##                           EDAD         SEXO TIPO DOLOR TORAX PRESIÓN ARTERIAL  CORESTEROL NIVEL DE AZÚCAR ECG EN REPOSO FREC CARDÍACA MÁX ANGINA x EJERCICIO
## EDAD                1.00000000  0.010307251       0.07064056      0.265638310  0.05557662      0.17719557    0.15301742       -0.36737055         0.18478532
## SEXO                0.01030725  1.000000000       0.14393924     -0.006190966 -0.17030775      0.10983323   -0.02065464       -0.17072969         0.18312750
## TIPO DOLOR TORAX    0.07064056  0.143939237       1.00000000      0.035017478 -0.05318981      0.14023978    0.05055787       -0.26539514         0.21247464
## PRESIÓN ARTERIAL    0.26563831 -0.006190966       0.03501748      1.000000000  0.10091912      0.09287163    0.05902914       -0.09833084         0.13454092
## CORESTEROL          0.05557662 -0.170307752      -0.05318981      0.100919123  1.00000000     -0.05485501    0.04623150        0.07215950         0.04545846
## NIVEL DE AZÚCAR     0.17719557  0.109833233       0.14023978      0.092871629 -0.05485501      1.00000000    0.03366667       -0.12336361         0.05888944
## ECG EN REPOSO       0.15301742 -0.020654643       0.05055787      0.059029140  0.04623150      0.03366667    1.00000000        0.03680226         0.02065208
## FREC CARDÍACA MÁX  -0.36737055 -0.170729692      -0.26539514     -0.098330842  0.07215950     -0.12336361    0.03680226        1.00000000        -0.37732721
## ANGINA x EJERCICIO  0.18478532  0.183127496       0.21247464      0.134540924  0.04545846      0.05888944    0.02065208       -0.37732721         1.00000000
## OLDPEAK             0.24752994  0.095590850       0.08451111      0.176890078  0.06230374      0.03594124    0.07711587       -0.18634309         0.37165510
## PENDIENTE ST        0.16103760  0.036364404      -0.03765429      0.017546990  0.04571129      0.06589316    0.04976452       -0.04619899         0.19758205
## E. CARDIACA         0.15913980  0.144474318       0.40242504      0.053535720 -0.03116443      0.20237228    0.07378645       -0.20844073         0.27053481
##                        OLDPEAK PENDIENTE ST E. CARDIACA
## EDAD                0.24752994   0.16103760  0.15913980
## SEXO                0.09559085   0.03636440  0.14447432
## TIPO DOLOR TORAX    0.08451111  -0.03765429  0.40242504
## PRESIÓN ARTERIAL    0.17689008   0.01754699  0.05353572
## CORESTEROL          0.06230374   0.04571129 -0.03116443
## NIVEL DE AZÚCAR     0.03594124   0.06589316  0.20237228
## ECG EN REPOSO       0.07711587   0.04976452  0.07378645
## FREC CARDÍACA MÁX  -0.18634309  -0.04619899 -0.20844073
## ANGINA x EJERCICIO  0.37165510   0.19758205  0.27053481
## OLDPEAK             1.00000000   0.21639692  0.18230327
## PENDIENTE ST        0.21639692   1.00000000  0.44099197
## E. CARDIACA         0.18230327   0.44099197  1.00000000
#Representación de las correlaciones
corrplot(cor_datos, method = "pie", type="upper")

#Representación de las correlaciones II
corrplot(cor_datos, method = 'shade', order = 'AOE')

#Representación de las correlaciones III
corrplot(cor_datos, method = 'color', order = 'alphabet')

Para representar las correlaciones, se ha usado diferentes métodos para ver las relaciones entre las características y verlo de una manera más clara.

1.4.5 Análisis de componentes principales (PCA)

Ahora se va a realizar un análisis de componentes sobre el conjunto de datos final. Lo primero que vamos a calcular es la varianza de todas las caracteristicas

#Cálculo de la varianza de los componentes.
var <- apply(datos_final, 2, var)
var
##               EDAD               SEXO   TIPO DOLOR TORAX   PRESIÓN ARTERIAL         CORESTEROL    NIVEL DE AZÚCAR      ECG EN REPOSO  FREC CARDÍACA MÁX 
##         87.4315033          0.1808166          1.2233549        319.6802285       3071.0066876          0.1672628          0.5577678        647.8786644 
## ANGINA x EJERCICIO            OLDPEAK       PENDIENTE ST        E. CARDIACA 
##          0.2369530          1.1930804          0.4791289          0.2475826

Como se puede observar de una manera bastante clara, el colesterol es la característica que mas varia de un individuo a otro.

Lo siguiente es centrar y escalar las características, para que así las variables pierdan esa variabilidad. Una vez calculada la matriz se la asigno al pca

#Calculo de la descomposición de los componentes
pca <- prcomp(datos_final, scale = TRUE, center = TRUE)
pca
## Standard deviations (1, .., p=12):
##  [1] 1.6004587 1.1848672 1.0951841 1.0481039 0.9890992 0.9745326 0.9269463 0.8877397 0.8482690 0.7815714 0.6725318 0.6153182
## 
## Rotation (n x k) = (12 x 12):
##                            PC1         PC2         PC3         PC4         PC5         PC6          PC7         PC8         PC9        PC10        PC11        PC12
## EDAD                0.34186886 -0.31597048  0.27284093 -0.19719939  0.22036848 -0.03054682  0.394699966 -0.08280293  0.22183975  0.36136298 -0.52567759 -0.04105846
## SEXO                0.19695232  0.41874758  0.10159710  0.15624946  0.27521660  0.29068895 -0.504704790 -0.26613424  0.47328322  0.20038552 -0.03160227  0.01325580
## TIPO DOLOR TORAX    0.29666462  0.35074626  0.05130859 -0.20673459 -0.62151831 -0.01899374 -0.054090760  0.21433908 -0.07062946  0.25414392 -0.13918932  0.46811458
## PRESIÓN ARTERIAL    0.19450631 -0.38116848  0.34117489 -0.12963613  0.09326520 -0.14196344 -0.451908479  0.59104748  0.20098241 -0.19698004  0.14233904  0.04249900
## CORESTEROL         -0.00374595 -0.49964402 -0.11013691  0.06643287 -0.48129712 -0.26512415 -0.280661867 -0.51650117  0.25923726  0.10709899  0.08476148 -0.02138766
## NIVEL DE AZÚCAR     0.21033679  0.13463534  0.08129254 -0.55672296  0.28629720 -0.36105881 -0.243445587 -0.39721389 -0.40491044 -0.14495703  0.05220850  0.06338703
## ECG EN REPOSO       0.09336401 -0.24452791 -0.10070730 -0.47737624 -0.12088456  0.77374750  0.032622175 -0.11710842  0.01879421 -0.20963938  0.14467617  0.01221850
## FREC CARDÍACA MÁX  -0.38060216 -0.12436986 -0.37924919 -0.14428722  0.06495553  0.08338277 -0.443236654  0.16417138 -0.17641796  0.15005294 -0.62169000 -0.01746038
## ANGINA x EJERCICIO  0.40752387 -0.01395628  0.04453332  0.40393678 -0.13276279  0.08562358 -0.068550323 -0.12478324 -0.18542885 -0.62077660 -0.45065005 -0.02282787
## OLDPEAK             0.34104005 -0.25190114 -0.02266335  0.34168704  0.10252245  0.21743906 -0.169711382  0.02498367 -0.57518714  0.48245931  0.22445107 -0.04209029
## PENDIENTE ST        0.27131324 -0.14004149 -0.64813472  0.06883012  0.31757589 -0.11948995  0.115175138  0.06047606  0.19934936 -0.08228308  0.10069380  0.54153156
## E. CARDIACA         0.40579248  0.17380336 -0.44823765 -0.17158263 -0.13882935 -0.13737285  0.003426377  0.20485733  0.11751791  0.04498669  0.04568829 -0.69045089

Se puede ver que la primera componente tiene la mayor desviación estándar de todos los componentes. Para verlo de una manera mas clara, se va a representar de una manera grafica la salida anterior

#Representación PCA´s anteriores
screeplot(pca)

plot(pca, type = "l")

#Juntamos las dos gráficas anteriores
fviz_eig(pca)

Como se ha dicho antes, tanto de una manera numérica como gráfica, el PC1 es el que mejor de todos con una diferencia notable. Si usamos la técnica del codo, deberíamos coger solamente las dos primeras componentes.

Para confirmar la interpretación, no estaría de más obtener las estadísticas de todas las componentes

#Estadísticas de las componentes
summary(pca)
## Importance of components:
##                           PC1    PC2     PC3     PC4     PC5     PC6    PC7     PC8     PC9   PC10    PC11    PC12
## Standard deviation     1.6005 1.1849 1.09518 1.04810 0.98910 0.97453 0.9269 0.88774 0.84827 0.7816 0.67253 0.61532
## Proportion of Variance 0.2135 0.1170 0.09995 0.09154 0.08153 0.07914 0.0716 0.06567 0.05996 0.0509 0.03769 0.03155
## Cumulative Proportion  0.2135 0.3305 0.43040 0.52194 0.60347 0.68261 0.7542 0.81989 0.87985 0.9308 0.96845 1.00000

Viendo las estadísticas vemos que con las dos primeras componentes solamente podríamos explicar un 33,05% de los datos.Como no queremos perder información en el modelo, nos tendríamos que quedar con todas las componentes.

Para verlo de una manera visual, se va a representar la PCA de una manera gráfica.

#Representación de variables sobre componentes principales
fviz_pca_var(pca, repel = TRUE, scale = 0)

#Representación de observaciones sobre componentes principales
fviz_pca_ind(pca, col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), repel = TRUE)

#Representa la contribución de filas/columnas de los resultados de un pca
fviz_contrib(pca,choice = "var") 

Una vez que hemos representada las variables y los individuos, se va a fusionar estas dos gráficas

#Representación de variables y los individuos en la misma gráfica
fviz_pca_biplot(pca, repel = TRUE, col.var = "#2E9FDF", col.ind = "#696969")

Aunque la opción de repelerse esta activada al ser bastantes casos no se puede ver una manera correcta, así que se a mostrar solamente los 10, 20 y 30 casos más influyentes

#Representación de variables y los 10 individuos más influyentes en la misma gráfica
fviz_pca_biplot(pca, repel = TRUE, col.var = "#2E9FDF", col.ind = "#696969", select.ind = list(contrib = 10))

#Representación de variables y los 10 individuos más influyentes en la misma gráfica
fviz_pca_biplot(pca, repel = TRUE, col.var = "#2E9FDF", col.ind = "#696969", select.ind = list(contrib = 20))

#Representación de variables y los 10 individuos más influyentes en la misma gráfica
fviz_pca_biplot(pca, repel = TRUE, col.var = "#2E9FDF", col.ind = "#696969", select.ind = list(contrib = 30))

Al mostrar solamente los casos mas influyentes, se puede ver con mas claridad las relaciones entre los individuos y las características.

Podemos concluir de este análisis de componentes, que no se puede quitar ninguna característica ya que se perdería información.


2 SEGUNDA PARTE


En todos los puntos sucesivos se pide al estudiante, además de aplicar los diferentes métodos, de analizar correctamente el problema, detallar de manera exhaustiva resaltando el por qué y cómo se ha realizado, incluyendo elementos visuales, explicando los resultados, realizar las comparativas oportunas con sus conclusiones.

NOTA: En esta actividad vamos a usar al mismo dataset un método no supervisado y supervisado.

De este modo se pide al estudiante que complete los siguientes pasos:

  1. Aplicar un modelo no supervisado y basado en el concepto de distancia, sobre el juego de datos.

  2. Aplicar de nuevo el modelo anterior, pero usando una métrica distinta y comparar los resultados.

  3. Se aplican lo algoritmos DBSCAN y OPTICS, se prueban con diferentes valores de eps y se comparan los resultados con los métodos anteriores.

  4. Aplicar un modelo de generación de reglas a partir de árboles de decisión ajustando las diferentes opciones de creación como sin y con opciones de poda o boosting y comparar los resultados.

  5. Aplicar un modelo supervisado diferente al anterior a elegir de los vistos en el material docente.Comparar el resultado con el modelo generado anterior.

  6. Identificar eventuales limitaciones del dataset seleccionado y analizar los riesgos para el caso de uso.

2.1 Modelo no supervisado y basado en el concepto de distancia.

El modelo no supervisado basado en distancias que se va a aplicar es el de K-means, la idea fundamental de este algoritmo es agrupar objetos en k grupos basándose en sus características. El agrupamiento se realiza minimizando la suma de distancias entre cada objeto y el centroide de su grupo o clúster.

Antes de nada, se va a crear una copia del juego de datos preparado.

#Creación de la copia de juego de datos
datos_kmeans <- datos_final

Inicialmente, es bueno mostrar la distancia entre los datos, por lo que se calcularan y mostraran las distancia.

#Obtenemos las distancias
distance <- get_dist(datos_kmeans)
#Mostramos las distancias de una manera gráfica
fviz_dist(distance, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))

Una vez mostrada las distancias debemos calcular el numero óptimo de clústeres, como este proceso puede ser bastante confuso y arbitrario, se usarán varios métodos para obtener el numero correcto.

# Método del codo
set.seed(123)
fviz_nbclust(datos_kmeans, kmeans, method = "wss")

# Método de silueta promedio
fviz_nbclust(datos_kmeans, kmeans, method = "silhouette")

Una vez que ya sabemos el número de cluster (k = 2), se va a aplicar el método K-Means a los datos.

#Calculo de la K-means
set.seed(123)
k_mean <- kmeans(datos_kmeans, center = 2, iter.max = 100)
#Centro de los datos
k_mean$centers 
##       EDAD      SEXO TIPO DOLOR TORAX PRESIÓN ARTERIAL CORESTEROL NIVEL DE AZÚCAR ECG EN REPOSO FREC CARDÍACA MÁX ANGINA x EJERCICIO   OLDPEAK PENDIENTE ST E. CARDIACA
## 1 54.64802 0.6853147         1.818182         134.9837   296.9184       0.1794872     0.6480186          141.7483          0.4195804 1.0100233    0.8508159   0.5221445
## 2 53.22222 0.8055556         1.994949         130.8510   206.8106       0.2297980     0.5505051          139.0455          0.3661616 0.8791667    0.8143939   0.5669192
#Centro de los clusteres
table(k_mean$cluster)
## 
##   1   2 
## 429 792

Y podemos representar gráficamente los dos cluster con sus respectivos centroides.

#Representación gráfica
fviz_cluster(k_mean, data = datos_kmeans)

Para facilitar la comprensión, se van a mostrar las estadísticas descriptivas de los clúster.

#Estadísticas Descriptivas
datos_kmeans%>% 
  mutate(Cluster = k_mean$cluster) %>% 
  group_by(Cluster) %>% 
  summarise_all("mean")
## # A tibble: 2 x 13
##   Cluster  EDAD  SEXO `TIPO DOLOR TORAX` `PRESIÓN ARTERIAL` CORESTEROL `NIVEL DE AZÚCAR` `ECG EN REPOSO` `FREC CARDÍACA MÁX` `ANGINA x EJERCICIO` OLDPEAK `PENDIENTE ST`
##     <int> <dbl> <dbl>              <dbl>              <dbl>      <dbl>             <dbl>           <dbl>               <dbl>                <dbl>   <dbl>          <dbl>
## 1       1  54.6 0.685               1.82               135.       297.             0.179           0.648                142.                0.420   1.01           0.851
## 2       2  53.2 0.806               1.99               131.       207.             0.230           0.551                139.                0.366   0.879          0.814
## # ... with 1 more variable: E. CARDIACA <dbl>

Finalmente, se puede ver que el “dato objetivo” (aunque en métodos no supervisados no existe un campo objetivo, se va a mostrar la división de los clústeres en cuestión de si el paciente tiene o no una enfermedad cardiaca) queda distribuido en los cluster de la siguiente forma:

#Comparación dato objetivo
table(datos_kmeans$`E. CARDIACA`, k_mean$cluster, dnn = c("Original", "cluster" ) )
##         cluster
## Original   1   2
##        0 205 343
##        1 224 449

Comparando los elementos podemos concluir que en los dos grupos hay más o menos el mismo grupo de paciente con enfermedad cardiaca y paciente que no tienen, no obstante se va a calcular la calidad del modelo.

#Calidad del Modelo
d  <- daisy(datos_kmeans) 
sk <- silhouette(k_mean$cluster, d)
mean(sk[,3])
## [1] 0.4077139

La calidad de este modelo es del 40,77%

A continuación, se comparará con otros números distintos de clústeres para ver como funciona la clasificación en cada caso.

#Calculamos los modelos
k2 <- k_mean
k3 <- kmeans(datos_kmeans, centers = 3, nstart = 25)
k4 <- kmeans(datos_kmeans, centers = 4, nstart = 25)
k5 <- kmeans(datos_kmeans, centers = 5, nstart = 25)

#Rrepresentamos los modelos
p1 <- fviz_cluster(k2, geom = "point", data = datos_kmeans)+ ggtitle("k = 2")
p2 <- fviz_cluster(k3, geom = "point", data = datos_kmeans)+ ggtitle("k = 3")
p3 <- fviz_cluster(k4, geom = "point", data = datos_kmeans)+ ggtitle("k = 4")
p4 <- fviz_cluster(k5, geom = "point", data = datos_kmeans)+ ggtitle("k = 5")

library(gridExtra)
grid.arrange(p1,p2,p3,p4, nrow = 2)

Para intentar obtener un modelo más fiable, se van a usar solamente las variables con variaciones numéricas, es decir, que no sean variables categóricas convertidas con un valor numérico según el valor. Las variables son: EDAD, PRESION ARTERIAL, CORESTEROL, FREC. CARDIACA MAX y OLDPEAK.

#Creación de la copia del nuevo juego de datos con los campos necesarios
datos_kmeans_2 <- datos_final[,c(1,4,5,8,10)]

Como se ha hecho anteriormente, es bueno mostrar la distancia entre los datos, por lo que se calcularan y mostraran las distancia.

#Obtenemos las distancias
distance <- get_dist(datos_kmeans_2)
#Mostramos las distancias de una manera gráfica
fviz_dist(distance, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))

Una vez mostrada las distancias debemos calcular el numero óptimo de clústeres.

# Método del codo
set.seed(123)
fviz_nbclust(datos_kmeans_2, kmeans, method = "wss")

# Método de silueta promedio
fviz_nbclust(datos_kmeans_2, kmeans, method = "silhouette")

Una vez que ya sabemos el número de cluster (k = 2), se va a aplicar el método K-Means a los datos.

#Calculo de la K-means
set.seed(123)
k_mean <- kmeans(datos_kmeans_2, center = 2, iter.max = 100)
#Centro de los datos
k_mean$centers 
##       EDAD PRESIÓN ARTERIAL CORESTEROL FREC CARDÍACA MÁX   OLDPEAK
## 1 54.64802         134.9837   296.9184          141.7483 1.0100233
## 2 53.22222         130.8510   206.8106          139.0455 0.8791667
#Centro de los clusteres
table(k_mean$cluster)
## 
##   1   2 
## 429 792

Y podemos representar gráficamente los dos cluster con sus respectivos centroides.

#Representación Gráfica
fviz_cluster(k_mean, data = datos_kmeans_2)

Para facilitar la comprensión, se van a mostrar las estadísticas descriptivas de los clúster.

#Estadísticas
datos_kmeans_2%>% 
  mutate(Cluster = k_mean$cluster) %>% 
  group_by(Cluster) %>% 
  summarise_all("mean")
## # A tibble: 2 x 6
##   Cluster  EDAD `PRESIÓN ARTERIAL` CORESTEROL `FREC CARDÍACA MÁX` OLDPEAK
##     <int> <dbl>              <dbl>      <dbl>               <dbl>   <dbl>
## 1       1  54.6               135.       297.                142.   1.01 
## 2       2  53.2               131.       207.                139.   0.879

Y se calcula la calidad del modelo.

#Calidad
d  <- daisy(datos_kmeans_2) 
sk <- silhouette(k_mean$cluster, d)
mean(sk[,3])
## [1] 0.4081857

La calidad de este modelo es del 40,81%

Comparando los resultados, la calidad del modelo con todas las variables y con la selección de las variables numérica es prácticamente igual. Por lo que podemos concluir que este tipo de métodos no es bueno para este conjunto de datos, teniendo una calidad bastante baja y no se consigue identificar bien si alguien tiene o no una enfermedad cardiaca.

2.2 Modificación del Modelo no supervisado usando una métrica distinta

Para realizar este ejercicio, se ha decidido usar distintas métricas de distancia distintas, para así poder comparar los resultados obtenidos con el modelo obtenido en el ejercicio anterior.

Por defecto, se calculan las distancias por el método de distancia euclidiana, en este caso vamos a probar con las distancias de Manhattan y correlación de Pearson

Además, se van a hacer la comparación con el juego de datos que contienen solo las variables numéricas (las categóricas convertidas a numéricas se eliminaran, como en el segundo modelo del ejercicio anterior).

2.2.1 Distancia de Manhattan

#Obtenemos las distancias
distance_Manhattan <- get_dist(datos_kmeans_2, method = "manhattan")
#Mostramos las distancias de una manera gráfica
fviz_dist(distance_Manhattan, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))

Como el número de clústeres son los mismos que en el ejercicio anterior (k =2), no hará falta calcularlos de nuevo, por lo que se va a aplicar el método K-Means a los datos.

#Calculo de la K-means
set.seed(123)
k_mean_Manhattan <- Kmeans(datos_kmeans_2, center = 2, iter.max = 100, method = 'manhattan')
#Centro de los datos
k_mean_Manhattan$centers 
##       EDAD PRESIÓN ARTERIAL CORESTEROL FREC CARDÍACA MÁX   OLDPEAK
## 1 54.71729         135.3411   296.9836          141.7827 1.0189252
## 2 53.18663         130.6633   206.8890          139.0303 0.8745271
#Centro de los clusteres
table(k_mean_Manhattan$cluster)
## 
##   1   2 
## 428 793

Y podemos representar gráficamente los dos cluster con sus respectivos centroides.

#Graficamos 
fviz_cluster(k_mean_Manhattan, data = datos_kmeans_2)

Para facilitar la comprensión, se van a mostrar las estadísticas descriptivas de los clúster.

#Estadísticas
datos_kmeans_2%>% 
  mutate(Cluster = k_mean_Manhattan$cluster) %>% 
  group_by(Cluster) %>% 
  summarise_all("mean")
## # A tibble: 2 x 6
##   Cluster  EDAD `PRESIÓN ARTERIAL` CORESTEROL `FREC CARDÍACA MÁX` OLDPEAK
##     <int> <dbl>              <dbl>      <dbl>               <dbl>   <dbl>
## 1       1  54.7               135.       297.                142.   1.02 
## 2       2  53.2               131.       207.                139.   0.875

Y se calcula la calidad del modelo.

#Calidad
d  <- daisy(datos_kmeans_2) 
sk <- silhouette(k_mean_Manhattan$cluster, d)
mean(sk[,3])
## [1] 0.4078561

2.2.2 Distancia de correlación de Pearson

#Obtenemos las distancias
distance_Pearson <- get_dist(datos_kmeans_2, method = "pearson")
#Mostramos las distancias de una manera gráfica
fviz_dist(distance_Pearson, gradient = list(low = "#00AFBB", mid = "white", high = "#FC4E07"))

Como el número de clústeres son los mismos que en el ejercicio anterior (k =2), no hará falta calcularlos de nuevo, por lo que se va a aplicar el método K-Means a los datos.

#Calculo de la K-means
set.seed(123)
library("amap")
k_mean_Pearson <- Kmeans(datos_kmeans_2, center = 2, iter.max = 100, method = 'pearson')
#Centro de los datos
k_mean_Pearson$centers 
##       EDAD PRESIÓN ARTERIAL CORESTEROL FREC CARDÍACA MÁX   OLDPEAK
## 1 54.88650         131.8806   281.2857          131.0431 1.0074364
## 2 52.88592         132.6070   207.6549          146.4380 0.8659155
#Centro de los clusteres
table(k_mean_Pearson$cluster)
## 
##   1   2 
## 511 710

Y podemos representar gráficamente los dos cluster con sus respectivos centroides.

#Graficamos 
fviz_cluster(k_mean_Pearson, data = datos_kmeans_2)

Para facilitar la comprensión, se van a mostrar las estadísticas descriptivas de los clúster.

#Estadísticas
datos_kmeans_2%>% 
  mutate(Cluster = k_mean_Pearson$cluster) %>% 
  group_by(Cluster) %>% 
  summarise_all("mean")
## # A tibble: 2 x 6
##   Cluster  EDAD `PRESIÓN ARTERIAL` CORESTEROL `FREC CARDÍACA MÁX` OLDPEAK
##     <int> <dbl>              <dbl>      <dbl>               <dbl>   <dbl>
## 1       1  54.9               132.       281.                131.   1.01 
## 2       2  52.9               133.       208.                146.   0.866

Y se calcula la calidad del modelo.

#Calidad
d  <- daisy(datos_kmeans_2) 
sk <- silhouette(k_mean_Manhattan$cluster, d)
mean(sk[,3])
## [1] 0.4078561

2.2.3 Análisis de resultados y comparación con el modelo del ejercicio anterior

Como se puede observar, la calidad de los dos modelos es: 0.4078561 y que no varia mucho de la calidad del modelo anterior.

Por eso, a nivel de conclusión, se puede decir que, aunque el método de k-means no es el mas eficiente para este conjunto de datos, las métricas tampoco han influido mucho en los resultados, por lo que se concluye que este modelo no supervisado no es el mejor para obtener una comparación eficiente del objetivo buscado.

2.3 DBSCAN y OPTICS

A continuación, se van a utilizar los métodos de clustering DBSCAN y OPTICS que permiten la generación de grupos no radiales a diferencia de K-Means. Lo primero será realizar una copia del juego de datos y seleccionar los numéricos.

#Copia de los datos y los campos que nos interesan
datos_dbscan <-  datos_final[,c(1,4,5,8,10)]

Una vez tenemos el juego de datos, se va realizar el modelo con un mimPts = 10.

#Creación del modelo
res10 <- optics(datos_dbscan, minPts = 10)
res10
## OPTICS ordering/clustering for 1221 objects.
## Parameters: minPts = 10, eps = 189.31729979059, eps_cl = NA, xi = NA
## Available fields: order, reachdist, coredist, predecessor, minPts, eps, eps_cl, xi

Obtenemos la ordenación de las observaciones o puntos

#Obervaciones ordenadas
res10$order
##    [1]    1  206  392  493  541  908  907  581  464  431  525  979 1016 1010 1174 1173 1162  987  914  909  851  779  770 1026 1161 1030  993  992 1095  948 1024  905
##   [33]  864  860  793  946  816  606  605  540  481  604  704  539  522  497  701  820  699  687  447  445  686  448  971  857  534 1066  869  824  759  709  653  500
##   [65]  910  890  542  705  692 1120 1074  648  641  625  616  521  424  655  359  815  997  995  749  724  399  319  406  390  592 1008  986  985  748  904  342  284
##   [97]  199  414  302  283  831 1168 1217 1216 1209 1208 1138 1175  896  958  919  747  814  295  760  754  818 1069  861  849  912  848  801  785  642  602  792  791
##  [129]  586  549  453  550  609  257  649  446  427  402  761  943  942 1064 1028  941  812  596  569  524  593  598  572  953  931  855   65 1164  895  362  511 1092
##  [161]  460  454  258  218  752  700  514  513  231  640  698  673  646  599  527  636 1036  963  758  728  635  543  526  518  495  478  863  835  477  469  451  396
##  [193]  395  463  462  450  356  400  375  175  110  349  156  155  307 1163 1154 1035 1020  899  898  756  727  494  468  120  119 1025  807  806  972  961  847  482
##  [225]  532  422  308  432  370  369  741  991  990  951  929  794  740 1143  498  133  132   87  150  149  144  137  136   43 1158  459  181  215  223  222  214  180
##  [257]  176   56   48   47   84  253 1125  968 1189 1040  872  251  104  213  670  845  844  685  684  681  417  340  484  803  802  483  393  193  167  314  444  587
##  [289] 1177 1075 1058  336  603  385  384  374  858  703  401 1105  694  582  506 1076  644  195  381  739  578  311  309  298  279  254  244  337  148   85   61  272
##  [321]  271   71   72   60   23    9  398  865  836  612  595  594  575  516  509  397  544  624  623  267  261  243  235  293  252  165  332  496  470  440  439  383
##  [353]  382  552  634  633  419  418  347  328  690  911 1031 1018  906  944  928  891  889  821  733  732  702  689  674  632  515  508  589  588  650  461 1157 1097
##  [385]  348 1122  734  819  786  735  286  268  306  305  897  294 1170 1169  296  387  380  301  300  208  207  141  115   86  978  126  125  680  679  529  719  718
##  [417]  528  334  333  304  303  339  338  177  678  677  200  188  121  355  579  408  259  240   45  250  695  957  409  903  888  361  365  364  358  357  354  346
##  [449]  327  217  216  273  551  512 1096 1088 1070  239  238  316  164  163  798  797  489  856  834  465  282  281  804  288  372   34   33  321  320 1144 1134 1023
##  [481]  659  404  378   82   81   53 1038 1021  956  933  389  138 1090  501  292  274 1091 1086  811  782  225  224  131  227  226  172  169  154  153  106  591  590
##  [513]  142  932 1153  228  210  114  263  262  113   64  345  160  277  276  485   74   62  410  278  537  335  285 1166 1165 1065 1055 1014 1013  955  976  966  939
##  [545]  938  111   99  269 1147  194  184   58  647   95   83  643  201  561  560  490  466   38  853  852  810   31   37   29 1029  331  330  762   77 1104  885  879
##  [577]  737  736  520  547  190  443   10   49 1187  691  366  256  246  123  122  868  838  805   76  935  324  209  559  558  112  100  667 1156 1155  790  789  377
##  [609] 1178  198  197  186   55   54  101  884  883  917 1198 1213 1207 1202 1111 1107 1085 1078 1041  826  808  710  662  379  787  656  628  611  823  545  519  711
##  [641]  657 1102  800  799  988  871  230  212  722  717 1103 1204 1201  394  571  105   75  959  921  645   52  974  964  886  880 1052  344  326 1199  683  566  565
##  [673] 1152 1151 1050  436  435  934  757 1094  937  915  870  764  729  708  312  658  568  829  767  693  350  325 1005  639  135  134 1093 1087  556 1137 1042   79
##  [705]   78    8  950  476  475  287 1072  411  391  780  771  651  438  437  159   12  434  433 1110 1109 1082 1081  918  893  846  669  668  554  553  386 1191 1171
##  [737]  116  472  317  310  297  178   93   59  107  945  920  827  788 1196 1195 1190 1182  102   39   30 1112  809  877 1141 1140 1184 1183 1118 1117  707  676 1146
##  [769] 1136  601 1068 1071 1057  999  980  970  969  751  574  423  982  538  343  323  795 1037  984  983  580   46  416  721  715  415  229  211  187  158  157  129
##  [801]  130  118  318  249  248  192  191  117   57  755  260  247 1032  774  773  555 1049 1048  927  923  425  421  420  412  817  784  564  563  458  430  916  892
##  [833]  140  619 1123 1115 1061 1060 1000  629  196  185 1051 1046  925  954 1179  973  962  924 1073  546  457  429  947  600  573  499  242   96  456  428  535  280
##  [865]  682  449  182  202   80   63   50   27   26   24   19  203 1012 1011  290  289  270 1180 1167  487  486  480  413 1121 1114   11  221   14  204  189 1022  867
##  [897]  441 1039  179 1098 1089  706  675  562  536  517  232  716  162  161  313 1186 1185  171   41 1015 1007  220  219   94  850  894 1211  597  570  523 1132 1127
##  [929] 1034  949  654 1206 1205   32  341  151  147  866  837    2  145  108   98 1131 1130  373  351  902  778  769  237  236   36 1212 1100  900  255  245  265  531
##  [961]  264   68   67   66  173  631  503  471  492  467  139  124   40   25   18 1119  637  363 1002 1126 1116 1200   69   21    7  168  152  996  745  744  360 1067
##  [993] 1056  952  930  661  567 1063 1062  926
##  [ reached getOption("max.print") -- omitted 221 entries ]

Gráficamente, se representa:

#Graficamos
plot(res10, main="Diagrama de alcanzabilidad", ylab="Distancia", xlab="Orden")

Otra representación del diagrama de alcanzabilidad, se observa en la siguiente imagen que es bastante menos clara.

#Graficamos
plot(datos_dbscan, col = "grey")
polygon(datos_dbscan[res10$order,])

Observando los datos indicados anteriormente, se presenta un eps de 189. Si se selecciona ese valor, quedará un cluster único, por lo que se va a obtener un valor de eps más óptimo.

#Representación con un ESP optimo
kNNdistplot(datos_dbscan, k = 6)
abline(h = 28,lty = 2,col = "red")

Extrayendo un clustering DBSCAN cortando la alcanzabilidad en el valor eps_cl de 28, se tiene:

#Se crea el modelo
db_scan_1 <- extractDBSCAN(res10, eps_cl = 28)
print(db_scan_1)
## OPTICS ordering/clustering for 1221 objects.
## Parameters: minPts = 10, eps = 189.31729979059, eps_cl = 28, xi = NA
## The clustering contains 2 cluster(s) and 34 noise points.
## 
##    0    1    2 
##   34 1176   11 
## 
## Available fields: order, reachdist, coredist, predecessor, minPts, eps, eps_cl, xi, cluster

Cuya representación es la que se muestra, viendo como hay 2 clusters con los valores outliers en negro:

#Representación Modelo
plot(db_scan_1, main="Diagrama de alcanzabilidad", ylab="Distancia", xlab="Orden")

Otra posible representación donde se ven los clusters y los outliers, es la siguiente:

#Representación Modelo
hullplot(datos_dbscan, db_scan_1, main = "clusters y outliers")

Repetimos el modelo anterior incrementando el parámetro epc_cl, veamos como el efecto que produce es la concentración de clusters ya que flexibilizamos la condición de densidad.

#Se crea el nuevo modelo
db_scan_2 <- extractDBSCAN(res10, eps_cl = 35)
print(db_scan_2)
## OPTICS ordering/clustering for 1221 objects.
## Parameters: minPts = 10, eps = 189.31729979059, eps_cl = 35, xi = NA
## The clustering contains 1 cluster(s) and 14 noise points.
## 
##    0    1 
##   14 1207 
## 
## Available fields: order, reachdist, coredist, predecessor, minPts, eps, eps_cl, xi, cluster

Esta vez solamente tenemos un único clúster, que representado de manera grafica queda de la siguiente forma:

#Representación Modelo
plot(db_scan_2)

#Representación Modelo
hullplot(datos_dbscan, db_scan_2)

Para validar el agrupamiento, se puede ver cómo están repartidos los datos originales en los diferentes clusters (en el primer caso):

#Tabla comparación datos
table(datos_final$`E. CARDIACA`, db_scan_1$cluster, dnn = c("Original", "cluster" ) )
##         cluster
## Original   0   1   2
##        0  12 530   6
##        1  22 646   5

Para validar el agrupamiento, se puede ver cómo están repartidos los datos originales en los diferentes clusters (en el segundo caso):

#Tabla comparación datos
table(datos_final$`E. CARDIACA`, db_scan_2$cluster, dnn = c("Original", "cluster" ) )
##         cluster
## Original   0   1
##        0   6 542
##        1   8 665

Se observa que no se obtiene una división bastante eficaz de los casos en que existe o no enfermedad cardiaca. Para mejorar la agrupación se va a modificar, inicialmente, el valor de minPts a 3, ya que existen valores muy juntos.

#Creación del modelo
res3 <- optics(datos_dbscan, minPts = 3)
res3
## OPTICS ordering/clustering for 1221 objects.
## Parameters: minPts = 3, eps = 78.2943165242535, eps_cl = NA, xi = NA
## Available fields: order, reachdist, coredist, predecessor, minPts, eps, eps_cl, xi

y de manera gráfica:

#Graficamos
kNNdistplot(datos_dbscan, k = 3)
abline(h = 28,lty = 2,col = "red")

#Creación del modelo
db_scan_2 <- extractDBSCAN(res3, eps_cl = 28)
print(db_scan_2)
## OPTICS ordering/clustering for 1221 objects.
## Parameters: minPts = 3, eps = 78.2943165242535, eps_cl = 28, xi = NA
## The clustering contains 2 cluster(s) and 17 noise points.
## 
##    0    1    2 
##   17 1201    3 
## 
## Available fields: order, reachdist, coredist, predecessor, minPts, eps, eps_cl, xi, cluster

En este caso, aunque tenemos dos clúster, el número de variación de los datos respecto a la distancia de 10 es muy poco significativa. La representación del diagrama de alcanzabilidad en este caso será:

#Representación del modelo
plot(db_scan_2, main="Diagrama de alcanzabilidad", ylab="Distancia", xlab="Orden")

Y la distribución de puntos:

#Representación del modelo
hullplot(datos_dbscan, db_scan_2)

Asimismo, la distribución de datos originales en los diferentes clusters:

#Tabla comparación datos
table(datos_final$`E. CARDIACA`, db_scan_2$cluster, dnn = c("Original", "cluster" ) )
##         cluster
## Original   0   1   2
##        0   6 540   2
##        1  11 661   1

Como se observa, pasa lo mismo que en el caso anterior, no hay distinción notable entre los casos que hay o no enfermedad cardiaca.

La medida de lo bueno que es el agrupamiento se puede calcular obteniendo primero el numero de casos de registros con enfermedad cardiaca y que no tienen enfermedad:

#Conteo de datos
count(datos_final, datos_final$`E. CARDIACA`)
##   datos_final$`E. CARDIACA`   n
## 1                         0 548
## 2                         1 673

Y haciendo una comparación entre todos los casos:

–En el primer caso (res10) tenemos 1175 (530 + 646) casos en el primer cluster y 11 en el segundo. El resto son datos ourliers.

–En el segundo caso (res3) tenemos 1201 casos en el primer cluster y 3 en el segundo. El resto son datos ourliers.

En conclusión, este modelo al igual que los dos anteriores no son eficaces para este conjunto de datos, en este caso en concreto la distancia que hay entre los datos no es tan influyente como puede ser otro tipos de datos.

2.4 Modelo de generación de reglas a partir de árboles de decisión

Lo primero que debemos hacer, es comprobar los campos más y menos influyente de una manera numérica, se hará unas pruebas estadísticas de significancia, para así determinar si se puede descartar algún campo. Para ellos se mirarán las proporciones, y luego se calculará los coeficientes V de Cramér y Phi.

#Campo EDAD
tabla_aux <- table(datos_final$EDAD,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)
##     
##              0         1
##   28 1.0000000 0.0000000
##   29 0.7500000 0.2500000
##   30 1.0000000 0.0000000
##   31 0.5000000 0.5000000
##   32 0.6000000 0.4000000
##   33 0.5000000 0.5000000
##   34 0.5555556 0.4444444
##   35 0.6000000 0.4000000
##   36 0.6666667 0.3333333
##   37 0.7692308 0.2307692
##   38 0.3157895 0.6842105
##   39 0.7368421 0.2631579
##   40 0.5625000 0.4375000
##   41 0.5588235 0.4411765
##   42 0.6153846 0.3846154
##   43 0.5000000 0.5000000
##   44 0.5333333 0.4666667
##   45 0.6538462 0.3461538
##   46 0.4516129 0.5483871
##   47 0.4166667 0.5833333
##   48 0.5000000 0.5000000
##   49 0.4615385 0.5384615
##   50 0.4375000 0.5625000
##   51 0.4893617 0.5106383
##   52 0.4285714 0.5714286
##   53 0.4878049 0.5121951
##   54 0.5074627 0.4925373
##   55 0.4489796 0.5510204
##   56 0.3877551 0.6122449
##   57 0.4000000 0.6000000
##   58 0.4262295 0.5737705
##   59 0.4285714 0.5714286
##   60 0.3720930 0.6279070
##   61 0.3076923 0.6923077
##   62 0.3695652 0.6304348
##   63 0.3333333 0.6666667
##   64 0.3437500 0.6562500
##   65 0.3448276 0.6551724
##   66 0.4500000 0.5500000
##   67 0.3750000 0.6250000
##   68 0.4285714 0.5714286
##   69 0.2500000 0.7500000
##   70 0.3636364 0.6363636
##   71 0.3750000 0.6250000
##   72 0.2500000 0.7500000
##   73 0.0000000 1.0000000
##   74 0.2500000 0.7500000
##   75 0.3333333 0.6666667
##   76 0.3333333 0.6666667
##   77 0.3333333 0.6666667
Phi(tabla_aux)
## [1] 0.2065394
CramerV(tabla_aux) 
## [1] 0.2065394

El tipo de asociación es baja, por lo que se descarta el campo.

#Campo SEXO
tabla_aux <- table(datos_final$SEXO ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)
##    
##             0         1
##   0 0.5778547 0.4221453
##   1 0.4087983 0.5912017
Phi(tabla_aux)
## [1] 0.1444743
CramerV(tabla_aux) 
## [1] 0.1444743

El tipo de asociación es baja, por lo que se descarta el campo.

#Campo TIPO DOLOR TORAX
tabla_aux <- table(datos_final$`TIPO DOLOR TORAX` ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)
##    
##             0         1
##   0 0.6878307 0.3121693
##   1 0.7085202 0.2914798
##   2 0.5137931 0.4862069
##   3 0.2138728 0.7861272
Phi(tabla_aux)
## [1] 0.4294639
CramerV(tabla_aux) 
## [1] 0.4294639

El tipo de asociación es media, por lo que se deja el campo.

#Campo PRESIÓN ARTERIAL
tabla_aux <- table(datos_final$`PRESIÓN ARTERIAL` ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)
##      
##               0         1
##   80  1.0000000 0.0000000
##   92  0.0000000 1.0000000
##   94  0.5000000 0.5000000
##   95  0.0000000 1.0000000
##   96  0.0000000 1.0000000
##   98  1.0000000 0.0000000
##   100 0.5263158 0.4736842
##   101 0.5000000 0.5000000
##   102 0.4000000 0.6000000
##   104 0.5000000 0.5000000
##   105 0.3333333 0.6666667
##   106 0.5000000 0.5000000
##   108 0.5384615 0.4615385
##   110 0.4805195 0.5194805
##   112 0.4782609 0.5217391
##   113 1.0000000 0.0000000
##   114 0.6666667 0.3333333
##   115 0.1818182 0.8181818
##   116 0.0000000 1.0000000
##   117 0.5000000 0.5000000
##   118 0.4705882 0.5294118
##   120 0.5352941 0.4647059
##   122 0.3125000 0.6875000
##   123 0.6666667 0.3333333
##   124 0.5000000 0.5000000
##   125 0.4250000 0.5750000
##   126 0.5000000 0.5000000
##   127 0.0000000 1.0000000
##   128 0.4333333 0.5666667
##   129 0.5000000 0.5000000
##   130 0.5129870 0.4870130
##   131 0.2500000 0.7500000
##   132 0.6000000 0.4000000
##   133 0.5000000 0.5000000
##   134 0.4375000 0.5625000
##   135 0.3461538 0.6538462
##   136 0.3125000 0.6875000
##   137 0.0000000 1.0000000
##   138 0.4333333 0.5666667
##   139 0.4000000 0.6000000
##   140 0.4820144 0.5179856
##   141 0.0000000 1.0000000
##   142 0.3571429 0.6428571
##   143 0.0000000 1.0000000
##   144 0.2000000 0.8000000
##   145 0.3043478 0.6956522
##   146 0.3333333 0.6666667
##   148 0.5000000 0.5000000
##   150 0.4583333 0.5416667
##   152 0.5000000 0.5000000
##   154 0.5000000 0.5000000
##   155 0.3333333 0.6666667
##   156 0.3333333 0.6666667
##   158 0.0000000 1.0000000
##   160 0.3606557 0.6393443
##   164 0.5000000 0.5000000
##   165 0.3333333 0.6666667
##   170 0.3333333 0.6666667
##   172 0.3333333 0.6666667
##   174 0.5000000 0.5000000
##   178 0.4000000 0.6000000
##   180 0.5333333 0.4666667
##   185 0.0000000 1.0000000
##   190 0.5000000 0.5000000
##   192 0.5000000 0.5000000
##   200 0.2000000 0.8000000
Phi(tabla_aux)
## [1] 0.2235984
CramerV(tabla_aux) 
## [1] 0.2235984

El tipo de asociación es baja, por lo que se descarta el campo.

#Campo CORESTEROL
tabla_aux <- table(datos_final$CORESTEROL ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)
##      
##               0         1
##   85  1.0000000 0.0000000
##   100 0.5000000 0.5000000
##   110 0.0000000 1.0000000
##   113 0.0000000 1.0000000
##   117 0.0000000 1.0000000
##   123 0.0000000 1.0000000
##   126 0.3333333 0.6666667
##   129 1.0000000 0.0000000
##   131 0.5000000 0.5000000
##   132 1.0000000 0.0000000
##   139 0.5000000 0.5000000
##   141 0.5000000 0.5000000
##   142 0.0000000 1.0000000
##   147 1.0000000 0.0000000
##   149 0.5000000 0.5000000
##   152 0.0000000 1.0000000
##   153 0.0000000 1.0000000
##   156 0.0000000 1.0000000
##   157 0.5000000 0.5000000
##   159 1.0000000 0.0000000
##   160 0.5714286 0.4285714
##   161 1.0000000 0.0000000
##   163 1.0000000 0.0000000
##   164 0.3333333 0.6666667
##   165 1.0000000 0.0000000
##   166 0.6000000 0.4000000
##   167 0.7500000 0.2500000
##   168 0.6666667 0.3333333
##   169 0.6666667 0.3333333
##   170 0.0000000 1.0000000
##   171 0.6666667 0.3333333
##   172 0.3333333 0.6666667
##   173 0.5000000 0.5000000
##   174 0.5000000 0.5000000
##   175 0.4285714 0.5714286
##   176 0.5000000 0.5000000
##   177 0.5000000 0.5000000
##   178 0.5000000 0.5000000
##   179 1.0000000 0.0000000
##   180 0.5000000 0.5000000
##   181 1.0000000 0.0000000
##   182 0.6666667 0.3333333
##   183 0.5000000 0.5000000
##   184 0.8000000 0.2000000
##   185 0.7500000 0.2500000
##   186 0.2857143 0.7142857
##   187 0.6666667 0.3333333
##   188 0.6666667 0.3333333
##   190 0.5000000 0.5000000
##   192 0.5000000 0.5000000
##   193 0.3750000 0.6250000
##   194 1.0000000 0.0000000
##   195 0.7500000 0.2500000
##   196 0.6250000 0.3750000
##   197 0.5384615 0.4615385
##   198 0.1333333 0.8666667
##   199 0.5000000 0.5000000
##   200 0.6000000 0.4000000
##   201 0.5555556 0.4444444
##   202 0.3333333 0.6666667
##   203 0.4000000 0.6000000
##   204 0.4666667 0.5333333
##   205 0.4000000 0.6000000
##   206 0.4000000 0.6000000
##   207 0.6250000 0.3750000
##   208 0.4444444 0.5555556
##   209 0.7142857 0.2857143
##   210 0.4000000 0.6000000
##   211 0.5384615 0.4615385
##   212 0.4545455 0.5454545
##   213 0.5555556 0.4444444
##   214 0.4444444 0.5555556
##   215 0.8571429 0.1428571
##   216 0.3636364 0.6363636
##   217 0.4000000 0.6000000
##   218 0.5000000 0.5000000
##   219 0.4545455 0.5454545
##   220 0.6153846 0.3846154
##   221 0.4285714 0.5714286
##   222 0.3750000 0.6250000
##   223 0.4615385 0.5384615
##   224 0.7142857 0.2857143
##   225 0.5555556 0.4444444
##   226 0.4000000 0.6000000
##   227 0.6666667 0.3333333
##   228 0.4285714 0.5714286
##   229 0.5714286 0.4285714
##   230 0.5833333 0.4166667
##   231 0.3750000 0.6250000
##   232 0.4000000 0.6000000
##   233 0.4000000 0.6000000
##   234 0.4615385 0.5384615
##   235 0.5714286 0.4285714
##   236 0.4444444 0.5555556
##   237 0.4285714 0.5714286
##   238 1.0000000 0.0000000
##   239 0.5000000 0.5000000
##   240 0.6666667 0.3333333
##   241 0.6000000 0.4000000
##   242 0.3333333 0.6666667
##   243 0.5454545 0.4545455
##   244 0.4285714 0.5714286
##   245 0.5555556 0.4444444
##   246 0.4545455 0.5454545
##   247 0.4000000 0.6000000
##   248 0.2500000 0.7500000
##   249 0.6250000 0.3750000
##   250 0.6250000 0.3750000
##   251 1.0000000 0.0000000
##   252 0.5000000 0.5000000
##   253 0.6666667 0.3333333
##   254 0.5625000 0.4375000
##   255 0.4000000 0.6000000
##   256 0.5000000 0.5000000
##   257 0.5000000 0.5000000
##   258 0.4000000 0.6000000
##   259 0.6666667 0.3333333
##   260 0.5000000 0.5000000
##   261 0.4000000 0.6000000
##   262 0.5000000 0.5000000
##   263 0.4545455 0.5454545
##   264 0.3750000 0.6250000
##   265 0.3333333 0.6666667
##   266 0.5000000 0.5000000
##   267 0.2857143 0.7142857
##   268 0.4285714 0.5714286
##   269 0.5454545 0.4545455
##   270 0.3750000 0.6250000
##   271 0.6666667 0.3333333
##   272 0.6666667 0.3333333
##   273 0.5714286 0.4285714
##   274 0.5555556 0.4444444
##   275 0.5555556 0.4444444
##   276 0.6000000 0.4000000
##   277 0.4285714 0.5714286
##   278 0.5000000 0.5000000
##   279 0.0000000 1.0000000
##   280 0.5000000 0.5000000
##   281 0.5000000 0.5000000
##   282 0.3636364 0.6363636
##   283 0.6250000 0.3750000
##   284 0.6000000 0.4000000
##   285 0.0000000 1.0000000
##   286 0.5000000 0.5000000
##   287 0.5000000 0.5000000
##   288 0.3333333 0.6666667
##   289 0.3750000 0.6250000
##   290 0.3333333 0.6666667
##   291 0.3333333 0.6666667
##   292 0.5000000 0.5000000
##   293 0.5000000 0.5000000
##   294 0.5000000 0.5000000
##   295 0.5714286 0.4285714
##   297 0.7500000 0.2500000
##   298 0.5714286 0.4285714
##   299 0.5000000 0.5000000
##   300 0.3333333 0.6666667
##   302 0.5000000 0.5000000
##   303 0.4285714 0.5714286
##   304 0.5000000 0.5000000
##   305 0.4000000 0.6000000
##   306 0.2500000 0.7500000
##   307 0.6666667 0.3333333
##   308 0.6250000 0.3750000
##   309 0.5714286 0.4285714
##   310 0.3333333 0.6666667
##   311 0.3333333 0.6666667
##   312 0.5000000 0.5000000
##   313 0.5000000 0.5000000
##   315 0.6000000 0.4000000
##   316 0.0000000 1.0000000
##   318 0.6000000 0.4000000
##   319 0.5000000 0.5000000
##   320 1.0000000 0.0000000
##   321 0.5000000 0.5000000
##   322 0.5000000 0.5000000
##   325 0.5000000 0.5000000
##   326 0.6666667 0.3333333
##   327 0.5000000 0.5000000
##   328 1.0000000 0.0000000
##   329 0.0000000 1.0000000
##   330 0.5000000 0.5000000
##   331 0.0000000 1.0000000
##   333 0.0000000 1.0000000
##   335 0.5000000 0.5000000
##   336 0.0000000 1.0000000
##   337 0.0000000 1.0000000
##   338 0.0000000 1.0000000
##   339 0.5000000 0.5000000
##   340 0.6666667 0.3333333
##   341 0.2500000 0.7500000
##   342 0.2500000 0.7500000
##   344 1.0000000 0.0000000
##   347 1.0000000 0.0000000
##   349 0.0000000 1.0000000
##   353 0.5000000 0.5000000
##   354 0.5000000 0.5000000
##   355 0.0000000 1.0000000
##   358 1.0000000 0.0000000
##   360 0.5000000 0.5000000
##   365 1.0000000 0.0000000
##   369 0.0000000 1.0000000
##   384 0.0000000 1.0000000
##   385 1.0000000 0.0000000
##   388 0.0000000 1.0000000
##   392 0.0000000 1.0000000
##   393 0.0000000 1.0000000
##   394 0.6666667 0.3333333
##   404 0.0000000 1.0000000
##   407 0.5000000 0.5000000
##   409 0.5000000 0.5000000
##   412 1.0000000 0.0000000
##   417 0.5000000 0.5000000
##   458 1.0000000 0.0000000
##   466 0.0000000 1.0000000
##   468 1.0000000 0.0000000
##   491 0.0000000 1.0000000
##   518 0.0000000 1.0000000
##   529 0.0000000 1.0000000
##   564 0.5000000 0.5000000
##   603 0.0000000 1.0000000
Phi(tabla_aux)
## [1] 0.4081721
CramerV(tabla_aux) 
## [1] 0.4081721

El tipo de asociación es media, por lo que se deja el campo.

#Campo NIVEL DE AZÚCAR
tabla_aux <- table(datos_final$`NIVEL DE AZÚCAR`,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)
##    
##             0         1
##   0 0.5010395 0.4989605
##   1 0.2548263 0.7451737
Phi(tabla_aux)
## [1] 0.2023723
CramerV(tabla_aux) 
## [1] 0.2023723

El tipo de asociación es baja, por lo que se descarta el campo.

#Campo ECG EN REPOSO
tabla_aux <- table(datos_final$`ECG EN REPOSO` ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)
##    
##             0         1
##   0 0.4949928 0.5050072
##   1 0.3545455 0.6454545
##   2 0.4427083 0.5572917
Phi(tabla_aux)
## [1] 0.1211095
CramerV(tabla_aux) 
## [1] 0.1211095

El tipo de asociación es baja, por lo que se descarta el campo.

#Campo FREC CARDÍACA MÁX
tabla_aux <- table(datos_final$`FREC CARDÍACA MÁX` ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)
##      
##               0         1
##   60  0.0000000 1.0000000
##   63  0.0000000 1.0000000
##   67  0.0000000 1.0000000
##   69  1.0000000 0.0000000
##   70  0.0000000 1.0000000
##   71  0.5000000 0.5000000
##   72  0.0000000 1.0000000
##   73  0.0000000 1.0000000
##   77  0.0000000 1.0000000
##   78  0.0000000 1.0000000
##   80  0.5000000 0.5000000
##   82  0.0000000 1.0000000
##   83  0.0000000 1.0000000
##   84  0.0000000 1.0000000
##   86  0.5000000 0.5000000
##   87  0.0000000 1.0000000
##   88  0.3333333 0.6666667
##   90  0.5000000 0.5000000
##   91  0.0000000 1.0000000
##   92  0.0000000 1.0000000
##   93  0.0000000 1.0000000
##   94  0.0000000 1.0000000
##   95  0.3333333 0.6666667
##   96  0.4444444 0.5555556
##   97  0.5000000 0.5000000
##   98  0.2222222 0.7777778
##   99  0.2500000 0.7500000
##   100 0.4285714 0.5714286
##   102 0.0000000 1.0000000
##   103 0.3333333 0.6666667
##   104 0.0000000 1.0000000
##   105 0.2142857 0.7857143
##   106 0.3333333 0.6666667
##   107 1.0000000 0.0000000
##   108 0.2000000 0.8000000
##   109 0.2857143 0.7142857
##   110 0.3043478 0.6956522
##   111 0.5000000 0.5000000
##   112 0.2666667 0.7333333
##   113 0.1666667 0.8333333
##   114 0.5555556 0.4444444
##   115 0.2631579 0.7368421
##   116 0.5454545 0.4545455
##   117 0.1428571 0.8571429
##   118 0.3846154 0.6153846
##   119 0.0000000 1.0000000
##   120 0.3589744 0.6410256
##   121 0.1666667 0.8333333
##   122 0.2500000 0.7500000
##   123 0.2222222 0.7777778
##   124 0.2000000 0.8000000
##   125 0.3214286 0.6785714
##   126 0.4375000 0.5625000
##   127 0.3333333 0.6666667
##   128 0.2666667 0.7333333
##   129 0.4000000 0.6000000
##   130 0.3783784 0.6216216
##   131 0.4545455 0.5454545
##   132 0.5555556 0.4444444
##   133 0.5714286 0.4285714
##   134 0.4285714 0.5714286
##   135 0.6000000 0.4000000
##   136 0.5000000 0.5000000
##   137 0.8750000 0.1250000
##   138 0.5882353 0.4117647
##   139 0.6250000 0.3750000
##   140 0.4680851 0.5319149
##   141 0.5555556 0.4444444
##   142 0.6500000 0.3500000
##   143 0.4117647 0.5882353
##   144 0.5500000 0.4500000
##   145 0.4444444 0.5555556
##   146 0.6000000 0.4000000
##   147 0.5000000 0.5000000
##   148 0.4285714 0.5714286
##   149 0.2500000 0.7500000
##   150 0.5000000 0.5000000
##   151 0.5555556 0.4444444
##   152 0.5263158 0.4736842
##   153 0.5000000 0.5000000
##   154 0.5294118 0.4705882
##   155 0.5555556 0.4444444
##   156 0.4375000 0.5625000
##   157 0.4166667 0.5833333
##   158 0.5000000 0.5000000
##   159 0.4444444 0.5555556
##   160 0.6764706 0.3235294
##   161 0.5000000 0.5000000
##   162 0.5000000 0.5000000
##   163 0.4736842 0.5263158
##   164 0.6666667 0.3333333
##   165 0.6250000 0.3750000
##   166 0.3750000 0.6250000
##   167 0.6666667 0.3333333
##   168 0.6153846 0.3846154
##   169 0.5000000 0.5000000
##   170 0.6000000 0.4000000
##   171 0.5000000 0.5000000
##   172 0.5882353 0.4117647
##   173 0.4666667 0.5333333
##   174 0.5833333 0.4166667
##   175 0.5384615 0.4615385
##   176 0.5000000 0.5000000
##   177 0.5000000 0.5000000
##   178 0.5454545 0.4545455
##   179 0.5454545 0.4545455
##   180 0.6666667 0.3333333
##   181 0.5000000 0.5000000
##   182 0.4545455 0.5454545
##   184 0.8000000 0.2000000
##   185 0.8000000 0.2000000
##   186 0.5000000 0.5000000
##   187 0.5000000 0.5000000
##   188 0.6666667 0.3333333
##   190 0.6666667 0.3333333
##   192 0.5000000 0.5000000
##   194 0.5000000 0.5000000
##   195 0.5000000 0.5000000
##   202 0.5000000 0.5000000
Phi(tabla_aux)
## [1] 0.3185611
CramerV(tabla_aux) 
## [1] 0.3185611

El tipo de asociación es media, por lo que se deja el campo.

#Campo ANGINA x EJERCICIO
tabla_aux <- table(datos_final$`ANGINA x EJERCICIO` ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)
##    
##             0         1
##   0 0.5552597 0.4447403
##   1 0.2787234 0.7212766
Phi(tabla_aux)
## [1] 0.2705348
CramerV(tabla_aux) 
## [1] 0.2705348

El tipo de asociación es media, por lo que se deja el campo.

#Campo OLDPEAK
tabla_aux <- table(datos_final$OLDPEAK ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)
##       
##                0         1
##   -2.6 0.0000000 1.0000000
##   -2   0.0000000 1.0000000
##   -1.5 0.0000000 1.0000000
##   -1.1 1.0000000 0.0000000
##   -1   0.0000000 1.0000000
##   -0.9 0.0000000 1.0000000
##   -0.8 0.0000000 1.0000000
##   -0.7 0.0000000 1.0000000
##   -0.5 0.5000000 0.5000000
##   -0.1 1.0000000 0.0000000
##   0    0.5760171 0.4239829
##   0.1  0.5714286 0.4285714
##   0.2  0.6176471 0.3823529
##   0.3  0.6428571 0.3571429
##   0.4  0.5000000 0.5000000
##   0.5  0.3333333 0.6666667
##   0.6  0.5000000 0.5000000
##   0.7  0.2500000 0.7500000
##   0.8  0.4827586 0.5172414
##   0.9  0.4285714 0.5714286
##   1    0.3600000 0.6400000
##   1.1  0.2222222 0.7777778
##   1.2  0.3953488 0.6046512
##   1.3  0.2500000 0.7500000
##   1.4  0.4193548 0.5806452
##   1.5  0.2068966 0.7931034
##   1.6  0.4444444 0.5555556
##   1.7  0.0000000 1.0000000
##   1.8  0.3703704 0.6296296
##   1.9  0.4166667 0.5833333
##   2    0.2470588 0.7529412
##   2.1  0.3333333 0.6666667
##   2.2  0.4444444 0.5555556
##   2.3  0.5000000 0.5000000
##   2.4  0.4285714 0.5714286
##   2.5  0.1111111 0.8888889
##   2.6  0.4615385 0.5384615
##   2.8  0.4615385 0.5384615
##   2.9  0.5000000 0.5000000
##   3    0.2121212 0.7878788
##   3.1  0.5000000 0.5000000
##   3.2  0.5000000 0.5000000
##   3.4  0.5000000 0.5000000
##   3.5  0.3333333 0.6666667
##   3.6  0.5000000 0.5000000
##   3.7  0.0000000 1.0000000
##   3.8  0.5000000 0.5000000
##   4    0.2727273 0.7272727
##   4.2  0.5000000 0.5000000
##   4.4  0.5000000 0.5000000
##   5    0.0000000 1.0000000
##   5.6  0.5000000 0.5000000
##   6.2  0.5000000 0.5000000
Phi(tabla_aux)
## [1] 0.301659
CramerV(tabla_aux) 
## [1] 0.301659

El tipo de asociación es media, por lo que se deja el campo.

#Campo PENDIENTE ST
tabla_aux <- table(datos_final$`PENDIENTE ST` ,datos_final$`E. CARDIACA`)
prop.table(tabla_aux, margin = 1)
##    
##             0         1
##   0 0.7908654 0.2091346
##   1 0.2833333 0.7166667
##   2 0.2390244 0.7609756
Phi(tabla_aux)
## [1] 0.4953823
CramerV(tabla_aux) 
## [1] 0.4953823

El tipo de asociación es media, por lo que se deja el campo.

Siguiendo los valores de V de Cramer y Phi, los valores entre 0.1 y 0.3 nos indican que la asociación estadística es baja, y entre 0.3 y 0.5 se puede considerar una asociación media. Finalmente, si los valores fueran superiores a 0.5, la asociación estadística entre las variables sería alta.

#Se hace una copia de los datos
datos_CRAMER_PHI_ALTO <- datos_final

#Se elimina los campos
datos_CRAMER_PHI_ALTO$EDAD <- NULL
datos_CRAMER_PHI_ALTO$SEXO <- NULL
datos_CRAMER_PHI_ALTO$`PRESIÓN ARTERIAL` <- NULL
datos_CRAMER_PHI_ALTO$`NIVEL DE AZÚCAR` <- NULL
datos_CRAMER_PHI_ALTO$`ECG EN REPOSO` <- NULL

#Normalizamos el campo Enfermedad
datos_CRAMER_PHI_ALTO$`E. CARDIACA`[datos_CRAMER_PHI_ALTO$`E. CARDIACA` == 1] <- "SI"
datos_CRAMER_PHI_ALTO$`E. CARDIACA`[datos_CRAMER_PHI_ALTO$`E. CARDIACA` == 0] <- "NO"
datos_CRAMER_PHI_ALTO$`E. CARDIACA` <- as.factor(datos_CRAMER_PHI_ALTO$`E. CARDIACA`)

#Renombramos columnas
colnames(datos_CRAMER_PHI_ALTO)[1]<-  "TIPO_DOLOR_TORAX"
colnames(datos_CRAMER_PHI_ALTO)[2]<-  "CORESTEROL"
colnames(datos_CRAMER_PHI_ALTO)[3]<-  "FREC_CARDÍACA_MAX"
colnames(datos_CRAMER_PHI_ALTO)[4]<-  "ANGINA_x_EJERCICIO"
colnames(datos_CRAMER_PHI_ALTO)[5]<-  "OLDPEAK"
colnames(datos_CRAMER_PHI_ALTO)[6]<-  "PENDIENTE_ST"
colnames(datos_CRAMER_PHI_ALTO)[7]<-  "E_CARDIACA"

Para evitar el error “Error in str2lang(x) : :1:10: unexpected symbol 1: y ~ TIPO DOLOR ^” a la hora de dibujar el árbol de decisión, se han cambiado los espacios por barra baja.

Ahora para proceder a preparar los datos, la primera cosa que debemos hacer es desordenar los datos.

#Desordenar los campos
set.seed(1)
data_random <- datos_CRAMER_PHI_ALTO[sample(nrow(datos_CRAMER_PHI_ALTO)),]

Como debemos dividir el conjunto de datos en dos grupos: entrenamiento y test, y al no existir un conjunto complementario ni proporción fijada, se hará 2/3 de los datos para el entrenamiento y 1/3 de los datos para el test.

La variable por la que clasificaremos es el campo de si la persona tiene o no una enfermedad cardiaca, que está en la última columna. De esta forma, tendremos un conjunto de datos para el entrenamiento y uno para la validación.

#Dividir los campos
set.seed(666)
y <- data_random[,7] 
X <- data_random
X[,7] <- NULL 

De forma dinámica podemos definir una forma de separar los datos en función de un parámetro, en este caso del “split_prop”. Definimos un parámetro que controla el split de forma dinámica en el test.

#Separar los registros
split_prop <- 3 
max_split<-floor(nrow(X)/split_prop)
tr_limit <- nrow(X)-max_split
ts_limit <- nrow(X)-max_split+1

trainX <- X[1:tr_limit,]
trainy <- y[1:tr_limit]
testX <- X[(ts_limit+1):nrow(X),]
testy <- y[(ts_limit+1):nrow(X)]

En la segunda opción podemos crear directamente un rango utilizando el mismo parámetro anterior.

#Separar los registros
split_prop <- 3 
indexes = sample(1:nrow(datos_CRAMER_PHI_ALTO), size=floor(((split_prop-1)/split_prop)*nrow(datos_CRAMER_PHI_ALTO)))
trainX<-X[indexes,]
trainy<-y[indexes]
testX<-X[-indexes,]
testy<-y[-indexes]

Al extraer aleatoriamente los datos, se hará un análisis mínimo de los datos para asegurarnos de no obtener clasificadores sesgados por los valores que contiene cada muestra.

En este caso, verificaremos que la proporción de personas con enfermedad es más o menos constante en los dos conjuntos.

#Verificar proporción de los datos
summary(trainX);
##  TIPO_DOLOR_TORAX   CORESTEROL    FREC_CARDÍACA_MAX ANGINA_x_EJERCICIO    OLDPEAK         PENDIENTE_ST   
##  Min.   :0.000    Min.   : 85.0   Min.   : 60.0     Min.   :0.0000     Min.   :-2.6000   Min.   :0.0000  
##  1st Qu.:1.000    1st Qu.:198.0   1st Qu.:121.2     1st Qu.:0.0000     1st Qu.: 0.0000   1st Qu.:0.0000  
##  Median :2.000    Median :226.0   Median :140.0     Median :0.0000     Median : 0.7000   Median :1.0000  
##  Mean   :1.985    Mean   :238.3   Mean   :139.4     Mean   :0.4042     Mean   : 0.9287   Mean   :0.8194  
##  3rd Qu.:3.000    3rd Qu.:270.0   3rd Qu.:159.0     3rd Qu.:1.0000     3rd Qu.: 1.6000   3rd Qu.:1.0000  
##  Max.   :3.000    Max.   :603.0   Max.   :202.0     Max.   :1.0000     Max.   : 6.2000   Max.   :2.0000
#Verificar proporción del dato objetivo
summary(trainy)
##  NO  SI 
## 366 448
#Verificar proporción de los datos
summary(testX)
##  TIPO_DOLOR_TORAX   CORESTEROL    FREC_CARDÍACA_MAX ANGINA_x_EJERCICIO    OLDPEAK         PENDIENTE_ST   
##  Min.   :0.000    Min.   :123.0   Min.   : 72.0     Min.   :0.0000     Min.   :-2.0000   Min.   :0.0000  
##  1st Qu.:1.000    1st Qu.:198.5   1st Qu.:122.0     1st Qu.:0.0000     1st Qu.: 0.0000   1st Qu.:0.0000  
##  Median :2.000    Median :233.0   Median :143.0     Median :0.0000     Median : 0.5000   Median :1.0000  
##  Mean   :1.828    Mean   :238.8   Mean   :141.1     Mean   :0.3464     Mean   : 0.9179   Mean   :0.8428  
##  3rd Qu.:3.000    3rd Qu.:267.0   3rd Qu.:161.0     3rd Qu.:1.0000     3rd Qu.: 1.5000   3rd Qu.:1.0000  
##  Max.   :3.000    Max.   :564.0   Max.   :202.0     Max.   :1.0000     Max.   : 4.4000   Max.   :2.0000
#Verificar proporción del dato objetivo
summary(testy)
##  NO  SI 
## 182 225

Se puede verificar, que hay aproximadamente la misma proporción en el conjunto de entrenamiento y de test.

Ya que tenemos los conjuntos preparados, se crea el árbol de decisión con los datos de entrenamiento.

#Creamos el arbol y lo mostramos
trainy = as.factor(trainy)
model <- C50::C5.0(trainX, trainy,rules=TRUE)
summary(model)
## 
## Call:
## C5.0.default(x = trainX, y = trainy, rules = TRUE)
## 
## 
## C5.0 [Release 2.07 GPL Edition]      Mon Jan 03 19:51:50 2022
## -------------------------------
## 
## Class specified by attribute `outcome'
## 
## Read 814 cases (7 attributes) from undefined.data
## 
## Rules:
## 
## Rule 1: (184/14, lift 2.0)
##  TIPO_DOLOR_TORAX <= 2
##  PENDIENTE_ST <= 0
##  ->  class NO  [0.919]
## 
## Rule 2: (22/1, lift 2.0)
##  TIPO_DOLOR_TORAX <= 0
##  FREC_CARDÍACA_MAX <= 124
##  PENDIENTE_ST <= 1
##  ->  class NO  [0.917]
## 
## Rule 3: (44/4, lift 2.0)
##  TIPO_DOLOR_TORAX <= 0
##  OLDPEAK > 1.7
##  ->  class NO  [0.891]
## 
## Rule 4: (186/20, lift 2.0)
##  ANGINA_x_EJERCICIO <= 0
##  OLDPEAK <= 0.4
##  PENDIENTE_ST <= 0
##  ->  class NO  [0.888]
## 
## Rule 5: (60/10, lift 1.8)
##  TIPO_DOLOR_TORAX <= 0
##  ANGINA_x_EJERCICIO > 0
##  ->  class NO  [0.823]
## 
## Rule 6: (3, lift 1.8)
##  TIPO_DOLOR_TORAX <= 0
##  CORESTEROL > 280
##  ANGINA_x_EJERCICIO <= 0
##  PENDIENTE_ST > 1
##  ->  class NO  [0.800]
## 
## Rule 7: (215/19, lift 1.6)
##  TIPO_DOLOR_TORAX > 2
##  ANGINA_x_EJERCICIO > 0
##  ->  class SI  [0.908]
## 
## Rule 8: (244/31, lift 1.6)
##  TIPO_DOLOR_TORAX > 2
##  OLDPEAK > 0.4
##  ->  class SI  [0.870]
## 
## Rule 9: (534/147, lift 1.3)
##  PENDIENTE_ST > 0
##  ->  class SI  [0.724]
## 
## Default class: SI
## 
## 
## Evaluation on training data (814 cases):
## 
##          Rules     
##    ----------------
##      No      Errors
## 
##       9  136(16.7%)   <<
## 
## 
##     (a)   (b)    <-classified as
##    ----  ----
##     269    97    (a): class NO
##      39   409    (b): class SI
## 
## 
##  Attribute usage:
## 
##   94.35% PENDIENTE_ST
##   65.85% TIPO_DOLOR_TORAX
##   58.23% OLDPEAK
##   57.00% ANGINA_x_EJERCICIO
##    2.70% FREC_CARDÍACA_MAX
##    0.37% CORESTEROL
## 
## 
## Time: 0.0 secs

Como se puede observar tenemos 9 reglas, entre las mas influyentes tenemos las siguientes:

– TIPO_DOLOR_TORAX <=2 && PENDIENTE_ST <= 0 –> NO TIENE ENFERMEDAD. Validez: 91,9%.

– TIPO_DOLOR_TORAX <= 0 && PENDIENTE_ST <= 1 && FREC_CARDÍACA_MAX <= 124 –> NO TIENE ENFERMEDAD. Validez: 91,7%.

– TIPO_DOLOR_TORAX <= 0 && OLDPEAK > 1.7 –> NO TIENE ENFERMEDAD. Validez: 89,1%.

– ANGINA_x_EJERCICIO <= 0 && OLDPEAK <= 0.4 && PENDIENTE_ST <= 0 –> NO TIENE ENFERMEDAD. Validez: 88,8%.

– TIPO_DOLOR_TORAX <= 0 && ANGINA_x_EJERCICIO > 0 –> NO TIENE ENFERMEDAD. Validez: 82,3%.

– TIPO_DOLOR_TORAX <= 0 && CORESTEROL > 280 && ANGINA_x_EJERCICIO <= 0 && PENDIENTE_ST > 1 –> NO TIENE ENFERMEDAD. Validez: 80%.

– TIPO_DOLOR_TORAX > 2 && ANGINA_x_EJERCICIO > 0 –> SI TIENE ENFERMEDAD. Validez: 90,8%.

– TIPO_DOLOR_TORAX > 2&& OLDPEAK > 0.4 –> SI TIENE ENFERMEDAD. Validez: 87%.

– PENDIENTE_ST > 0 –> SI TIENE ENFERMEDAD. Validez: 72,4%

A continuación, mostramos el árbol obtenido.

#Se grafica el arbol
model <- C50::C5.0(trainX, trainy)
plot(model)

Una vez tenemos el modelo, podemos comprobar su calidad prediciendo la clase para los datos de prueba que nos hemos reservado al principio.

#Calculo de la precisión
predicted_model <- predict( model, testX, type="class" )
print(sprintf("La precisión del árbol es: %.4f %%",100*sum(predicted_model == testy) / length(predicted_model)))
## [1] "La precisión del árbol es: 80.8354 %"

Cuando hay pocas clases, la calidad de la predicción se puede analizar mediante una matriz de confusión que identifica los tipos de errores cometidos.

#Matriz de confusión
mat_conf<-table(testy,Predicted=predicted_model)
mat_conf
##      Predicted
## testy  NO  SI
##    NO 126  56
##    SI  22 203

Para tener información más completa se usará el paquete gmodels.

#Matriz de confusión completa
CrossTable(testy, predicted_model,prop.chisq  = FALSE, prop.c = FALSE, prop.r =FALSE,dnn = c('Reality', 'Prediction'))
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  407 
## 
##  
##              | Prediction 
##      Reality |        NO |        SI | Row Total | 
## -------------|-----------|-----------|-----------|
##           NO |       126 |        56 |       182 | 
##              |     0.310 |     0.138 |           | 
## -------------|-----------|-----------|-----------|
##           SI |        22 |       203 |       225 | 
##              |     0.054 |     0.499 |           | 
## -------------|-----------|-----------|-----------|
## Column Total |       148 |       259 |       407 | 
## -------------|-----------|-----------|-----------|
## 
## 

Dentro de las opciones que ofrece esta librería, está la opción de trials, que nos permite crear distintos modelos aplicando poda o no.En este caso, le vamos a dar un valor de 3.

#Creación del arbol con trial= 3
trainy = as.factor(trainy)
model <- C50::C5.0(trainX, trainy,rules=TRUE, trial=3)
summary(model)
## 
## Call:
## C5.0.default(x = trainX, y = trainy, trials = 3, rules = TRUE)
## 
## 
## C5.0 [Release 2.07 GPL Edition]      Mon Jan 03 19:51:51 2022
## -------------------------------
## 
## Class specified by attribute `outcome'
## 
## Read 814 cases (7 attributes) from undefined.data
## 
## -----  Trial 0:  -----
## 
## Rules:
## 
## Rule 0/1: (184/14, lift 2.0)
##  TIPO_DOLOR_TORAX <= 2
##  PENDIENTE_ST <= 0
##  ->  class NO  [0.919]
## 
## Rule 0/2: (22/1, lift 2.0)
##  TIPO_DOLOR_TORAX <= 0
##  FREC_CARDÍACA_MAX <= 124
##  PENDIENTE_ST <= 1
##  ->  class NO  [0.917]
## 
## Rule 0/3: (44/4, lift 2.0)
##  TIPO_DOLOR_TORAX <= 0
##  OLDPEAK > 1.7
##  ->  class NO  [0.891]
## 
## Rule 0/4: (186/20, lift 2.0)
##  ANGINA_x_EJERCICIO <= 0
##  OLDPEAK <= 0.4
##  PENDIENTE_ST <= 0
##  ->  class NO  [0.888]
## 
## Rule 0/5: (60/10, lift 1.8)
##  TIPO_DOLOR_TORAX <= 0
##  ANGINA_x_EJERCICIO > 0
##  ->  class NO  [0.823]
## 
## Rule 0/6: (3, lift 1.8)
##  TIPO_DOLOR_TORAX <= 0
##  CORESTEROL > 280
##  ANGINA_x_EJERCICIO <= 0
##  PENDIENTE_ST > 1
##  ->  class NO  [0.800]
## 
## Rule 0/7: (215/19, lift 1.6)
##  TIPO_DOLOR_TORAX > 2
##  ANGINA_x_EJERCICIO > 0
##  ->  class SI  [0.908]
## 
## Rule 0/8: (244/31, lift 1.6)
##  TIPO_DOLOR_TORAX > 2
##  OLDPEAK > 0.4
##  ->  class SI  [0.870]
## 
## Rule 0/9: (534/147, lift 1.3)
##  PENDIENTE_ST > 0
##  ->  class SI  [0.724]
## 
## Default class: SI
## 
## -----  Trial 1:  -----
## 
## Rules:
## 
## Rule 1/1: (225.9/59.9, lift 1.5)
##  ANGINA_x_EJERCICIO <= 0
##  PENDIENTE_ST <= 0
##  ->  class NO  [0.733]
## 
## Rule 1/2: (362.2/98.7, lift 1.4)
##  TIPO_DOLOR_TORAX <= 2
##  PENDIENTE_ST <= 1
##  ->  class NO  [0.726]
## 
## Rule 1/3: (194.8/37.9, lift 1.6)
##  TIPO_DOLOR_TORAX > 2
##  ANGINA_x_EJERCICIO > 0
##  ->  class SI  [0.802]
## 
## Rule 1/4: (244.3/53.9, lift 1.6)
##  TIPO_DOLOR_TORAX > 2
##  PENDIENTE_ST > 0
##  ->  class SI  [0.777]
## 
## Rule 1/5: (133.9/47.9, lift 1.3)
##  PENDIENTE_ST > 1
##  ->  class SI  [0.640]
## 
## Default class: NO
## 
## -----  Trial 2:  -----
## 
## Rules:
## 
## Rule 2/1: (198/40.5, lift 2.1)
##  PENDIENTE_ST <= 0
##  ->  class NO  [0.793]
## 
## Rule 2/2: (121.9/37, lift 1.9)
##  TIPO_DOLOR_TORAX <= 0
##  ->  class NO  [0.693]
## 
## Rule 2/3: (426.3/73.5, lift 1.6)
##  TIPO_DOLOR_TORAX > 0
##  PENDIENTE_ST > 0
##  ->  class SI  [0.826]
## 
## Default class: SI
## 
## 
## Evaluation on training data (814 cases):
## 
## Trial            Rules     
## -----      ----------------
##      No      Errors
## 
##    0      9  136(16.7%)
##    1      5  175(21.5%)
##    2      3  170(20.9%)
## boost            145(17.8%)   <<
## 
## 
##     (a)   (b)    <-classified as
##    ----  ----
##     279    87    (a): class NO
##      58   390    (b): class SI
## 
## 
##  Attribute usage:
## 
##  100.00% PENDIENTE_ST
##   93.86% TIPO_DOLOR_TORAX
##   62.78% ANGINA_x_EJERCICIO
##   58.23% OLDPEAK
##    2.70% FREC_CARDÍACA_MAX
##    0.37% CORESTEROL
## 
## 
## Time: 0.0 secs

Como se pude comprobar, tenemos ahora mismo 3 modelos distintos. El modelo 0 es el analizado antes, mientras que los otros dos tienen un número menor de reglas. El menor numero de reglas implica que la fiabilidad es menor, es decir se puede ver que en el primer modelo (con 9 reglas) es el que menor porcentaje de error tiene.

Lo que voy a comprobar ahora es la precisión del árbol con todas las variables, ya que se ha descartado la inmensa mayoría.

#Asignamos los datos 
set.seed(1)
data_random_completos <- datos_final[sample(nrow(datos_final)),]

#Separamos los valores
set.seed(666)
y_completo <- data_random_completos[,12] 
X_completo <- data_random_completos
X_completo[,12] <- NULL

#Separamos los campos
split_prop <- 3 
max_split<-floor(nrow(X_completo)/split_prop)
tr_limit <- nrow(X_completo)-max_split
ts_limit <- nrow(X_completo)-max_split+1

trainX <- X_completo[1:tr_limit,]
trainy <- y_completo[1:tr_limit]
testX <- X_completo[(ts_limit+1):nrow(X_completo),]
testy <- y_completo[(ts_limit+1):nrow(X_completo)]

split_prop <- 3 
indexes = sample(1:nrow(datos_final), size=floor(((split_prop-1)/split_prop)*nrow(datos_final)))
trainX<-X_completo[indexes,]
trainy<-y_completo[indexes]
testX<-X_completo[-indexes,]
testy<-y_completo[-indexes]

#Se crea el arbol de decisión
trainy = as.factor(trainy)
model <- C50::C5.0(trainX, trainy,rules=TRUE )

#Se obtiene la precision del arbol
predicted_model <- predict( model, testX, type="class" )
print(sprintf("La precisión del árbol con todos los campos es: %.4f %%",100*sum(predicted_model == testy) / length(predicted_model)))
## [1] "La precisión del árbol con todos los campos es: 77.1499 %"

En este caso, tenemos una predicción un poco mas baja con todas las variables.

Analizando el árbol inicial (con solo las variables seleccionadas) vemos el nivel de precisión en cada una de las reglas, siendo las reglas 1,2 y 7 las mas precisas, en las que comprueba las variables TIPO_DOLOR_TORAX, PENDIENTE_ST, FREC_CARDÍACA_MAX y ANGINA_x_EJERCICIO.

Se puede concluir que la capacidad de predicción del árbol es bastante buena, y que como se ha comprobado un análisis inicial de los campos, pueden ayudar a simplificar mucho la creación del árbol y en este caso mejorar la precisión.

2.5 Modelo supervisado

Finalmente, se van a crear otros modelos usando distintos métodos.

2.5.1 Modelo de Regresión

Lo primero será realizar una copia del juego de datos.

#Copia de los datos
datos_regresion <-  datos_final

Una vez obtenido la copia del conjunto de datos, se van a dividir en dos grupos: Train y Test.

#División datos
set.seed(123)
split = sample.split(datos_regresion$`E. CARDIACA`, SplitRatio = 0.8)
training_set = subset(datos_regresion, split = TRUE)
test_set = subset(datos_regresion, split = FALSE)

Escalar los valores numéricos

#Escalado 
training_set[ , c(1,4,5,8, 10)] =  scale(training_set[, c(1,4,5,8, 10)])
test_set[ , c(1,4,5,8, 10)] = scale(test_set[ , c(1,4,5,8, 10)])

Y creamos el modelo

#Creación modelo
classifier = glm(formula = `E. CARDIACA` ~ . ,
                 family = binomial,
                 data = training_set)

#Se muestra el modelo
summary(classifier)
## 
## Call:
## glm(formula = `E. CARDIACA` ~ ., family = binomial, data = training_set)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.0302  -0.6765   0.3242   0.6441   2.6244  
## 
## Coefficients:
##                       Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          -3.661762   0.264366 -13.851  < 2e-16 ***
## EDAD                  0.040845   0.087276   0.468    0.640    
## SEXO                  0.274229   0.182077   1.506    0.132    
## `TIPO DOLOR TORAX`    0.951883   0.073823  12.894  < 2e-16 ***
## `PRESIÓN ARTERIAL`    0.001546   0.080862   0.019    0.985    
## CORESTEROL           -0.080771   0.076802  -1.052    0.293    
## `NIVEL DE AZÚCAR`     0.902187   0.201456   4.478 7.52e-06 ***
## `ECG EN REPOSO`       0.134031   0.102559   1.307    0.191    
## `FREC CARDÍACA MÁX`  -0.102687   0.088493  -1.160    0.246    
## `ANGINA x EJERCICIO`  0.448711   0.176445   2.543    0.011 *  
## OLDPEAK               0.072676   0.086026   0.845    0.398    
## `PENDIENTE ST`        1.793144   0.124750  14.374  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1679.8  on 1220  degrees of freedom
## Residual deviance: 1102.2  on 1209  degrees of freedom
## AIC: 1126.2
## 
## Number of Fisher Scoring iterations: 5

Predicción para el conjunto de datos de prueba.

#Predicción
prob_pred = predict(classifier , type = 'response', newdata = test_set[1:12])
y_pred = ifelse(prob_pred > 0.5, 1, 0)
table(test_set[, 12], y_pred)
##    y_pred
##       0   1
##   0 419 129
##   1 111 562
y_pred <- as.factor(y_pred)
test_set[ ,12] = as.factor(test_set[ ,12])
library(caret)
library(e1071)

Y vemos el resultado en la Matriz de confusión.

#Matriz de confusión
confusionMatrix(y_pred , test_set$`E. CARDIACA`)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 419 111
##          1 129 562
##                                         
##                Accuracy : 0.8034        
##                  95% CI : (0.78, 0.8254)
##     No Information Rate : 0.5512        
##     P-Value [Acc > NIR] : <2e-16        
##                                         
##                   Kappa : 0.6015        
##                                         
##  Mcnemar's Test P-Value : 0.2725        
##                                         
##             Sensitivity : 0.7646        
##             Specificity : 0.8351        
##          Pos Pred Value : 0.7906        
##          Neg Pred Value : 0.8133        
##              Prevalence : 0.4488        
##          Detection Rate : 0.3432        
##    Detection Prevalence : 0.4341        
##       Balanced Accuracy : 0.7998        
##                                         
##        'Positive' Class : 0             
## 

De la regresión se ha obtenido una precisión del 80,34%, lo que es bastante bueno y es casi similar al modelo anterior de árboles de decisión.

2.5.2 KNN

Lo primero será realizar una copia del juego de datos.

#Copia de los datos
datos_knn <-  datos_final

Una vez obtenido la copia del conjunto de datos, se van a dividir en dos grupos: Train y Test y preparar los grupos.

#División de los datos
set.seed(123)
samp_size=floor(0.75*nrow(datos_knn))
samp_ind=sample(seq_len(nrow(datos_knn)),size = samp_size)
data_train=datos_knn[samp_ind,-12]
data_test=datos_knn[-samp_ind,-12]
data_train_labels=datos_knn[samp_ind,12]
data_test_labels=datos_knn[-samp_ind,12]

Y creamos el modelo

#Creación del modelo
knn=knn(train = data_train,test = data_test,cl=data_train_labels,k=10)

Predicción para el conjunto de datos de prueba.

#Predicción
CrossTable(x=data_test_labels,y=data_test_pred,prop.chisq = FALSE)
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  306 
## 
##  
##                  | data_test_pred 
## data_test_labels |         0 |         1 | Row Total | 
## -----------------|-----------|-----------|-----------|
##                0 |        56 |        77 |       133 | 
##                  |     0.421 |     0.579 |     0.435 | 
##                  |     0.483 |     0.405 |           | 
##                  |     0.183 |     0.252 |           | 
## -----------------|-----------|-----------|-----------|
##                1 |        60 |       113 |       173 | 
##                  |     0.347 |     0.653 |     0.565 | 
##                  |     0.517 |     0.595 |           | 
##                  |     0.196 |     0.369 |           | 
## -----------------|-----------|-----------|-----------|
##     Column Total |       116 |       190 |       306 | 
##                  |     0.379 |     0.621 |           | 
## -----------------|-----------|-----------|-----------|
## 
## 
#Matriz de confusión
confusionMatrix(table(data_test_labels,data_test_pred))
## Confusion Matrix and Statistics
## 
##                 data_test_pred
## data_test_labels   0   1
##                0  56  77
##                1  60 113
##                                           
##                Accuracy : 0.5523          
##                  95% CI : (0.4947, 0.6089)
##     No Information Rate : 0.6209          
##     P-Value [Acc > NIR] : 0.9940          
##                                           
##                   Kappa : 0.0753          
##                                           
##  Mcnemar's Test P-Value : 0.1716          
##                                           
##             Sensitivity : 0.4828          
##             Specificity : 0.5947          
##          Pos Pred Value : 0.4211          
##          Neg Pred Value : 0.6532          
##              Prevalence : 0.3791          
##          Detection Rate : 0.1830          
##    Detection Prevalence : 0.4346          
##       Balanced Accuracy : 0.5387          
##                                           
##        'Positive' Class : 0               
## 

La precisión de este modelo es 55,23% la mas baja de entre todos los modelos supervisados.

2.5.3 Comparación modelos supervisados

A nivel de comparación, se va a mostrar la tabla de todos los modelos:

MODELO SUPERVISADO PRECISIÓN
ARBOL DE DECISIÓN 80.83%
REGRESIÓN 80,34%
KNN 55,23%

Como se puede observar en la tabla anterior, de los 3 modelos creados, dos son prácticamente igual de precisos (arboles de decisión y regresión) y el modelo de KNN ha dado una precisión mas baja.

No obstante, este conjunto de datos estaba pensado para este tipo de modelos supervisados, y se ha conseguido una precisión (a mi juicio) bastante buena.

2.6 Limitaciones del dataset y analisis de Riesgos

Entre las limitaciones que podemos encontrar en este conjunto de datos es que desde el principio de todo tenemos una variable objetivo, lo cual descarta casi por completo usar modelos no supervisados. No obstante, se ha confirmado esta conclusión en los distintos modelos no supervisados creados, teniendo una predicción menor al 50%.

Por otro lado, tenemos los modelos supervisados, en donde se han creado 3 modelos distintos y se han obtenido en dos de ellos una precisión superior al 80% y en el restante superior al 50%. Los resultados del conjunto de datos en estos modelos son los esperados, ya que al poseer una variable objetivo el conjunto de datos funciona para este tipo de modelos.

Si quisiéramos usar este modelo para predecir casos reales (a mi juicio) se debería crear un modelo supervisado (árbol de decisión para ver las reglas y así poder y analizarlas para ver si tienen sentido).

Por otro lado, se han obtenido los datos de dos dataset distintos, pero la suma de ellos no supera 1500 registros, por lo que seria bueno obtener más registros a través de otros dataset (y se debería obtener de casos actualizados y de las mismas zonas geográficas).

Además, en el juego de datos finales se ha descartado dos campos de uno de los conjuntos (ya que el conjunto de datos con más registros no poseía esos campos) por lo que podríamos empeorar la predicción al poder ser datos decisivos a la hora de generar el modelo supervisado. Por otro lado, y siguiendo en la misma línea, creo que seria bueno completar el conjunto de datos con mas campos (no solo los descartados, si no con un mayor número) que se consideren relevantes.

Finalmente se debería probar el modelo creado con un medico especializado, para que se comprueben simultáneamente el resultado del modelo y el juicio del médico y así poder comparar y ajustar el modelo. Esta propuesta, además, permitirá generar añadir nuevos datos de forma correcta.


3 Criterios de evaluación



4 Recursos de programación



5 Formato y fecha de entrega


El formato de entrega es: username_estudiante-PRA2 .Rmd y el output generado en uno de estos formatos html/doc/docx/odt/pdf.

Se debe entregar la PRA en el buzón de entregas del aula en formato comprimido que incluye los ficheros: - ejecutable - output - el dataset seleccionado o en su defecto indicar la ruta para su descarga en el ejecutable.


6 Nota: Propiedad intelectual


A menudo es inevitable, al producir una obra multimedia, hacer uso de recursos creados por terceras personas. Es por lo tanto comprensible hacerlo en el marco de una práctica de los estudios de Informática, Multimedia y Telecomunicación de la UOC, siempre y cuando esto se documente claramente y no suponga plagio en la práctica.

Por lo tanto, al presentar una práctica que haga uso de recursos ajenos, se debe presentar junto con ella un documento en que se detallen todos ellos, especificando el nombre de cada recurso, su autor, el lugar donde se obtuvo y su estatus legal: si la obra esta protegida por el copyright o se acoge a alguna otra licencia de uso (Creative Commons, licencia GNU, GPL …). El estudiante deberá asegurarse de que la licencia no impide específicamente su uso en el marco de la práctica. En caso de no encontrar la información correspondiente tendrá que asumir que la obra esta protegida por copyright.

Deberéis, además, adjuntar los ficheros originales cuando las obras utilizadas sean digitales, y su código fuente si corresponde.

Para realizar esta práctica se ha usado y analizado distintos códigos proporcionados en la pagina donde se ha obtenidos los datos:

https://www.kaggle.com/ronitf/heart-disease-uci/code

https://www.kaggle.com/fedesoriano/heart-failure-prediction/code

Además, se ha usado la documentación oficial de R para ver las distintas funciones y sus prametros.